From 0feb95b3374978056c40bdaf882f052386787bcc Mon Sep 17 00:00:00 2001 From: Vaibhav Sagar Date: Fri, 7 Apr 2017 19:03:41 +0700 Subject: [PATCH] Implement fixes suggested by HLint --- ShellCheck/AST.hs | 23 +++++++------- ShellCheck/ASTLib.hs | 36 +++++++++++----------- ShellCheck/Analytics.hs | 64 +++++++++++++++++++-------------------- ShellCheck/AnalyzerLib.hs | 18 +++++------ ShellCheck/Interface.hs | 7 +++-- 5 files changed, 74 insertions(+), 74 deletions(-) diff --git a/ShellCheck/AST.hs b/ShellCheck/AST.hs index 16309fc..961a897 100644 --- a/ShellCheck/AST.hs +++ b/ShellCheck/AST.hs @@ -19,21 +19,21 @@ -} module ShellCheck.AST where -import Control.Monad import Control.Monad.Identity import Text.Parsec import qualified ShellCheck.Regex as Re +import Prelude hiding (id) -data Id = Id Int deriving (Show, Eq, Ord) +newtype Id = Id Int deriving (Show, Eq, Ord) data Quoted = Quoted | Unquoted deriving (Show, Eq) data Dashed = Dashed | Undashed deriving (Show, Eq) data AssignmentMode = Assign | Append deriving (Show, Eq) -data FunctionKeyword = FunctionKeyword Bool deriving (Show, Eq) -data FunctionParentheses = FunctionParentheses Bool deriving (Show, Eq) +newtype FunctionKeyword = FunctionKeyword Bool deriving (Show, Eq) +newtype FunctionParentheses = FunctionParentheses Bool deriving (Show, Eq) data CaseType = CaseBreak | CaseFallThrough | CaseContinue deriving (Show, Eq) -data Root = Root Token +newtype Root = Root Token data Token = TA_Binary Id String Token Token | TA_Assignment Id String Token Token @@ -49,7 +49,7 @@ data Token = | TC_Or Id ConditionType String Token Token | TC_Unary Id ConditionType String Token | T_AND_IF Id - | T_AndIf Id (Token) (Token) + | T_AndIf Id Token Token | T_Arithmetic Id Token | T_Array Id [Token] | T_IndexedElement Id [Token] Token @@ -110,7 +110,7 @@ data Token = | T_NEWLINE Id | T_NormalWord Id [Token] | T_OR_IF Id - | T_OrIf Id (Token) (Token) + | T_OrIf Id Token Token | T_ParamSubSpecialChar Id String -- e.g. '%' in ${foo%bar} or '/' in ${foo/bar/baz} | T_Pipeline Id [Token] [Token] -- [Pipe separators] [Commands] | T_ProcSub Id String [Token] @@ -162,11 +162,6 @@ analyze f g i = i newT roundAll = mapM round - roundMaybe Nothing = return Nothing - roundMaybe (Just v) = do - s <- round v - return (Just s) - dl l v = do x <- roundAll l return $ v x @@ -277,6 +272,7 @@ analyze f g i = delve (T_Include id includer script) = d2 includer script $ T_Include id delve t = return t +getId :: Token -> Id getId t = case t of T_AND_IF id -> id T_OR_IF id -> id @@ -379,7 +375,10 @@ getId t = case t of blank :: Monad m => Token -> m () blank = const $ return () +doAnalysis :: Monad m => (Token -> m ()) -> Token -> m Token doAnalysis f = analyze f blank return +doStackAnalysis :: Monad m => (Token -> m ()) -> (Token -> m ()) -> Token -> m Token doStackAnalysis startToken endToken = analyze startToken endToken return +doTransform :: (Token -> Token) -> Token -> Token doTransform i = runIdentity . analyze blank blank (return . i) diff --git a/ShellCheck/ASTLib.hs b/ShellCheck/ASTLib.hs index 52e0167..e8c2a2c 100644 --- a/ShellCheck/ASTLib.hs +++ b/ShellCheck/ASTLib.hs @@ -48,8 +48,8 @@ willSplit x = T_NormalWord _ l -> any willSplit l _ -> False -isGlob (T_Extglob {}) = True -isGlob (T_Glob {}) = True +isGlob T_Extglob {} = True +isGlob T_Glob {} = True isGlob (T_NormalWord _ l) = any isGlob l isGlob _ = False @@ -144,9 +144,9 @@ mayBecomeMultipleArgs t = willBecomeMultipleArgs t || f t -- Is it certain that this word will becomes multiple words? willBecomeMultipleArgs t = willConcatInAssignment t || f t where - f (T_Extglob {}) = True - f (T_Glob {}) = True - f (T_BraceExpansion {}) = True + f T_Extglob {} = True + f T_Glob {} = True + f T_BraceExpansion {} = True f (T_DoubleQuoted _ parts) = any f parts f (T_NormalWord _ parts) = any f parts f _ = False @@ -154,7 +154,7 @@ willBecomeMultipleArgs t = willConcatInAssignment t || f t -- This does token cause implicit concatenation in assignments? willConcatInAssignment token = case token of - t@(T_DollarBraced {}) -> isArrayExpansion t + t@T_DollarBraced {} -> isArrayExpansion t (T_DoubleQuoted _ parts) -> any willConcatInAssignment parts (T_NormalWord _ parts) -> any willConcatInAssignment parts _ -> False @@ -169,7 +169,7 @@ onlyLiteralString = fromJust . getLiteralStringExt (const $ return "") -- Maybe get a literal string, but only if it's an unquoted argument. getUnquotedLiteral (T_NormalWord _ list) = - liftM concat $ mapM str list + concat <$> mapM str list where str (T_Literal _ s) = return s str _ = Nothing @@ -186,7 +186,7 @@ getTrailingUnquotedLiteral t = where from t = case t of - (T_Literal {}) -> return t + T_Literal {} -> return t _ -> Nothing -- Maybe get the literal string of this token and any globs in it. @@ -200,7 +200,7 @@ getGlobOrLiteralString = getLiteralStringExt f getLiteralStringExt :: (Token -> Maybe String) -> Token -> Maybe String getLiteralStringExt more = g where - allInList = liftM concat . mapM g + allInList = fmap concat . mapM g g (T_DoubleQuoted _ l) = allInList l g (T_DollarDoubleQuoted _ l) = allInList l g (T_NormalWord _ l) = allInList l @@ -237,7 +237,7 @@ getCommand t = T_Redirecting _ _ w -> getCommand w T_SimpleCommand _ _ (w:_) -> return t T_Annotation _ _ t -> getCommand t - otherwise -> Nothing + _otherwise -> Nothing -- Maybe get the command name of a token representing a command getCommandName t = do @@ -259,13 +259,13 @@ getCommandNameFromExpansion t = T_DollarExpansion _ [c] -> extract c T_Backticked _ [c] -> extract c T_DollarBraceCommandExpansion _ [c] -> extract c - otherwise -> Nothing + _otherwise -> Nothing where extract (T_Pipeline _ _ [cmd]) = getCommandName cmd extract _ = Nothing -- Get the basename of a token representing a command -getCommandBasename = liftM basename . getCommandName +getCommandBasename = fmap basename . getCommandName where basename = reverse . takeWhile (/= '/') . reverse @@ -275,7 +275,7 @@ isAssignment t = T_SimpleCommand _ (w:_) [] -> True T_Assignment {} -> True T_Annotation _ _ w -> isAssignment w - otherwise -> False + _otherwise -> False isOnlyRedirection t = case t of @@ -283,7 +283,7 @@ isOnlyRedirection t = T_Annotation _ _ w -> isOnlyRedirection w T_Redirecting _ (_:_) c -> isOnlyRedirection c T_SimpleCommand _ [] [] -> True - otherwise -> False + _otherwise -> False isFunction t = case t of T_Function {} -> True; _ -> False @@ -301,14 +301,14 @@ getCommandSequences t = T_ForIn _ _ _ cmds -> [cmds] T_ForArithmetic _ _ _ _ cmds -> [cmds] T_IfExpression _ thens elses -> map snd thens ++ [elses] - otherwise -> [] + _otherwise -> [] -- Get a list of names of associative arrays getAssociativeArrays t = nub . execWriter $ doAnalysis f t where f :: Token -> Writer [String] () - f t@(T_SimpleCommand {}) = fromMaybe (return ()) $ do + f t@T_SimpleCommand {} = fromMaybe (return ()) $ do name <- getCommandName t guard $ name == "declare" || name == "typeset" let flags = getAllFlags t @@ -321,7 +321,7 @@ getAssociativeArrays t = nameAssignments t = case t of T_Assignment _ _ name _ _ -> return name - otherwise -> Nothing + _otherwise -> Nothing -- A Pseudoglob is a wildcard pattern used for checking if a match can succeed. -- For example, [[ $(cmd).jpg == [a-z] ]] will give the patterns *.jpg and ?, which @@ -333,7 +333,7 @@ data PseudoGlob = PGAny | PGMany | PGChar Char -- PGMany. wordToPseudoGlob :: Token -> Maybe [PseudoGlob] wordToPseudoGlob word = - simplifyPseudoGlob <$> concat <$> mapM f (getWordParts word) + simplifyPseudoGlob . concat <$> mapM f (getWordParts word) where f x = case x of T_Literal _ s -> return $ map PGChar s diff --git a/ShellCheck/Analytics.hs b/ShellCheck/Analytics.hs index a9783cc..c7fd320 100644 --- a/ShellCheck/Analytics.hs +++ b/ShellCheck/Analytics.hs @@ -358,13 +358,13 @@ checkPipePitfalls _ (T_Pipeline id _ commands) = do for ["grep", "wc"] $ \(grep:wc:_) -> - let flagsGrep = fromMaybe [] $ map snd <$> getAllFlags <$> getCommand grep - flagsWc = fromMaybe [] $ map snd <$> getAllFlags <$> getCommand wc + let flagsGrep = fromMaybe [] $ map snd . getAllFlags <$> getCommand grep + flagsWc = fromMaybe [] $ map snd . getAllFlags <$> getCommand wc in - unless ((any (`elem` ["o", "only-matching", "r", "R", "recursive"]) flagsGrep) || (any (`elem` ["m", "chars", "w", "words", "c", "bytes", "L", "max-line-length"]) flagsWc) || ((length flagsWc) == 0)) $ + unless (any (`elem` ["o", "only-matching", "r", "R", "recursive"]) flagsGrep || any (`elem` ["m", "chars", "w", "words", "c", "bytes", "L", "max-line-length"]) flagsWc || null flagsWc) $ style (getId grep) 2126 "Consider using grep -c instead of grep|wc -l." - didLs <- liftM or . sequence $ [ + didLs <- fmap or . sequence $ [ for' ["ls", "grep"] $ \x -> warn x 2010 "Don't use ls | grep. Use a glob or a for loop with a condition to allow non-alphanumeric filenames.", for' ["ls", "xargs"] $ @@ -440,7 +440,7 @@ prop_checkForInQuoted5 = verify checkForInQuoted "for f in ls; do true; done" prop_checkForInQuoted6 = verifyNot checkForInQuoted "for f in \"${!arr}\"; do true; done" checkForInQuoted _ (T_ForIn _ f [T_NormalWord _ [word@(T_DoubleQuoted id list)]] _) = when (any (\x -> willSplit x && not (mayBecomeMultipleArgs x)) list - || (liftM wouldHaveBeenGlob (getLiteralString word) == Just True)) $ + || (fmap wouldHaveBeenGlob (getLiteralString word) == Just True)) $ err id 2066 "Since you double quoted this, it will not word split, and the loop will only run once." checkForInQuoted _ (T_ForIn _ f [T_NormalWord _ [T_SingleQuoted id _]] _) = warn id 2041 "This is a literal string. To run as a command, use $(..) instead of '..' . " @@ -659,7 +659,7 @@ prop_checkConcatenatedDollarAt2 = verify checkConcatenatedDollarAt "echo ${arr[@ prop_checkConcatenatedDollarAt3 = verify checkConcatenatedDollarAt "echo $a$@" prop_checkConcatenatedDollarAt4 = verifyNot checkConcatenatedDollarAt "echo $@" prop_checkConcatenatedDollarAt5 = verifyNot checkConcatenatedDollarAt "echo \"${arr[@]}\"" -checkConcatenatedDollarAt p word@(T_NormalWord {}) +checkConcatenatedDollarAt p word@T_NormalWord {} | not $ isQuoteFree (parentMap p) word = unless (null $ drop 1 parts) $ mapM_ for array @@ -884,8 +884,8 @@ checkNumberComparisons params (TC_Binary id typ op lhs rhs) = do decimalError = "Decimals are not supported. " ++ "Either use integers only, or use bc or awk to compare." - checkStrings hs = - mapM_ stringError . take 1 . filter isNonNum $ hs + checkStrings = + mapM_ stringError . take 1 . filter isNonNum isNonNum t = fromMaybe False $ do s <- getLiteralStringExt (const $ return "") t @@ -968,7 +968,7 @@ checkConditionalAndOrs _ t = (TC_Or id SingleBracket "-o" _ _) -> warn id 2166 "Prefer [ p ] || [ q ] as [ p -o q ] is not well defined." - otherwise -> return () + _otherwise -> return () prop_checkQuotedCondRegex1 = verify checkQuotedCondRegex "[[ $foo =~ \"bar.*\" ]]" prop_checkQuotedCondRegex2 = verify checkQuotedCondRegex "[[ $foo =~ '(cow|bar)' ]]" @@ -1241,7 +1241,7 @@ checkUuoeVar _ p = unless (isCovered first rest || "-" `isPrefixOf` onlyLiteralString first) $ when (all couldBeOptimized vars) $ style id 2116 "Useless echo? Instead of 'cmd $(echo foo)', just use 'cmd foo'." - otherwise -> return () + _otherwise -> return () prop_checkTestRedirects1 = verify checkTestRedirects "test 3 > 1" @@ -1257,12 +1257,12 @@ checkTestRedirects _ (T_Redirecting id redirs cmd) | cmd `isCommand` "test" = suspicious t = -- Ignore redirections of stderr because these are valid for squashing e.g. int errors, case t of -- and >> and similar redirections because these are probably not comparisons. T_FdRedirect _ fd (T_IoFile _ op _) -> fd /= "2" && isComparison op - otherwise -> False + _otherwise -> False isComparison t = case t of T_Greater _ -> True T_Less _ -> True - otherwise -> False + _otherwise -> False checkTestRedirects _ _ = return () prop_checkSudoRedirect1 = verify checkSudoRedirect "sudo echo 3 > /proc/file" @@ -1665,7 +1665,7 @@ prop_checkQuotesInLiterals9 = verifyNotTree checkQuotesInLiterals "param=\"/foo/ checkQuotesInLiterals params t = doVariableFlowAnalysis readF writeF Map.empty (variableFlow params) where - getQuotes name = liftM (Map.lookup name) get + getQuotes name = fmap (Map.lookup name) get setQuotes name ref = modify $ Map.insert name ref deleteQuotes = modify . Map.delete parents = parentMap params @@ -1696,7 +1696,7 @@ checkQuotesInLiterals params t = squashesQuotes t = case t of T_DollarBraced id _ -> "#" `isPrefixOf` bracedString t - otherwise -> False + _otherwise -> False readF _ expr name = do assignment <- getQuotes name @@ -1899,7 +1899,7 @@ checkUnassignedReferences params t = warnings -- Similarly, ${foo[bar baz]} may not be referencing bar/baz. Just skip these. isInArray var t = any isArray $ getPath (parentMap params) t where - isArray (T_Array {}) = True + isArray T_Array {} = True isArray b@(T_DollarBraced _ _) | var /= getBracedReference (bracedString b) = True isArray _ = False @@ -1997,7 +1997,7 @@ checkPrefixAssignmentReference params t@(T_DollarBraced id value) = check (t:rest) = case t of T_SimpleCommand _ vars (_:_) -> mapM_ checkVar vars - otherwise -> check rest + _otherwise -> check rest checkVar (T_Assignment aId mode aName [] value) | aName == name && (aId `notElem` idPath) = do warn aId 2097 "This assignment is only seen by the forked process." @@ -2154,7 +2154,7 @@ checkCatastrophicRm params t@(T_SimpleCommand id _ tokens) | t `isCommand` "rm" f (T_Glob _ str) = return str f (T_DollarBraced _ word) = let var = onlyLiteralString word in - if any (flip isInfixOf var) [":?", ":-", ":="] + if any (`isInfixOf` var) [":?", ":-", ":="] then Nothing else return "" f _ = return "" @@ -2291,8 +2291,8 @@ checkTildeInPath _ (T_SimpleCommand _ vars _) = checkVar _ = return () hasTilde t = fromMaybe False (liftM2 elem (return '~') (getLiteralStringExt (const $ return "") t)) - isQuoted (T_DoubleQuoted {}) = True - isQuoted (T_SingleQuoted {}) = True + isQuoted T_DoubleQuoted {} = True + isQuoted T_SingleQuoted {} = True isQuoted _ = False checkTildeInPath _ _ = return () @@ -2313,7 +2313,7 @@ shellSupport t = case t of T_CaseExpression _ _ list -> forCase (map (\(a,_,_) -> a) list) T_DollarBraceCommandExpansion {} -> ("${ ..; } command expansion", [Ksh]) - otherwise -> ("", []) + _otherwise -> ("", []) where forCase seps | CaseContinue `elem` seps = ("cases with ;;&", [Bash]) forCase seps | CaseFallThrough `elem` seps = ("cases with ;&", [Bash, Ksh]) @@ -2329,7 +2329,7 @@ checkMultipleAppends params t = mapM_ checkList $ getCommandSequences t where checkList list = - mapM_ checkGroup (groupWith (liftM fst) $ map getTarget list) + mapM_ checkGroup (groupWith (fmap fst) $ map getTarget list) checkGroup (f:_:_:_) | isJust f = style (snd $ fromJust f) 2129 "Consider using { cmd1; cmd2; } >> file instead of individual redirects." @@ -2340,7 +2340,7 @@ checkMultipleAppends params t = file <- mapMaybe getAppend list !!! 0 return (file, id) getTarget _ = Nothing - getAppend (T_FdRedirect _ _ (T_IoFile _ (T_DGREAT {}) f)) = return f + getAppend (T_FdRedirect _ _ (T_IoFile _ T_DGREAT {} f)) = return f getAppend _ = Nothing @@ -2487,7 +2487,7 @@ checkMaskedReturns _ _ = return () prop_checkReadWithoutR1 = verify checkReadWithoutR "read -a foo" prop_checkReadWithoutR2 = verifyNot checkReadWithoutR "read -ar foo" -checkReadWithoutR _ t@(T_SimpleCommand {}) | t `isUnqualifiedCommand` "read" = +checkReadWithoutR _ t@T_SimpleCommand {} | t `isUnqualifiedCommand` "read" = unless ("r" `elem` map snd (getAllFlags t)) $ info (getId t) 2162 "read without -r will mangle backslashes." checkReadWithoutR _ _ = return () @@ -2503,7 +2503,7 @@ prop_checkUncheckedCd8 = verifyNotTree checkUncheckedCd "set -o errexit; cd foo; checkUncheckedCd params root = if hasSetE then [] else execWriter $ doAnalysis checkElement root where - checkElement t@(T_SimpleCommand {}) = + checkElement t@T_SimpleCommand {} = when(t `isUnqualifiedCommand` "cd" && not (isCdDotDot t) && not (isCondition $ getPath (parentMap params) t)) $ @@ -2555,7 +2555,7 @@ prop_checkTrailingBracket5 = verifyNot checkTrailingBracket "run bar ']'" checkTrailingBracket _ token = case token of T_SimpleCommand _ _ tokens@(_:_) -> check (last tokens) token - otherwise -> return () + _otherwise -> return () where check t command = case t of @@ -2566,7 +2566,7 @@ checkTrailingBracket _ token = guard $ opposite `notElem` parameters return $ warn id 2171 $ "Found trailing " ++ str ++ " outside test. Missing " ++ opposite ++ "?" - otherwise -> return () + _otherwise -> return () invert s = case s of "]]" -> "[[" @@ -2590,7 +2590,7 @@ checkReturnAgainstZero _ token = when (isExitCode exp) $ message (getId exp) TA_Sequence _ [exp] -> when (isExitCode exp) $ message (getId exp) - otherwise -> return () + _otherwise -> return () where check lhs rhs = if isZero rhs && isExitCode lhs @@ -2599,8 +2599,8 @@ checkReturnAgainstZero _ token = isZero t = getLiteralString t == Just "0" isExitCode t = case getWordParts t of - [exp@(T_DollarBraced {})] -> bracedString exp == "?" - otherwise -> False + [exp@T_DollarBraced {}] -> bracedString exp == "?" + _otherwise -> False message id = style id 2181 "Check exit code directly with e.g. 'if mycmd;', not indirectly with $?." prop_checkRedirectedNowhere1 = verify checkRedirectedNowhere "> file" @@ -2672,7 +2672,7 @@ checkArrayAssignmentIndices params root = guard $ '=' `elem` str return $ warn id 2191 "The = here is literal. To assign by index, use ( [index]=value ) with no spaces. To keep as literal, quote it." in - if (null literalEquals && isAssociative) + if null literalEquals && isAssociative then warn (getId t) 2190 "Elements in associative arrays need index, e.g. array=( [index]=value ) ." else sequence_ literalEquals @@ -2752,14 +2752,14 @@ checkSplittingInArrays params t = && not (isQuotedAlternativeReference part) && not (getBracedReference (bracedString part) `elem` variablesWithoutSpaces) -> warn id 2206 $ - if (shellType params == Ksh) + if shellType params == Ksh then "Quote to prevent word splitting, or split robustly with read -A or while read." else "Quote to prevent word splitting, or split robustly with mapfile or read -a." _ -> return () forCommand id = warn id 2207 $ - if (shellType params == Ksh) + if shellType params == Ksh then "Prefer read -A or while read to split command output (or quote to avoid splitting)." else "Prefer mapfile or read -a to split command output (or quote to avoid splitting)." diff --git a/ShellCheck/AnalyzerLib.hs b/ShellCheck/AnalyzerLib.hs index f855f3d..d73d3da 100644 --- a/ShellCheck/AnalyzerLib.hs +++ b/ShellCheck/AnalyzerLib.hs @@ -163,7 +163,7 @@ determineShell t = fromMaybe Bash $ do (ShellOverride s) -> return s _ -> fail "" getCandidates :: Token -> [Maybe String] - getCandidates t@(T_Script {}) = [Just $ fromShebang t] + getCandidates t@T_Script {} = [Just $ fromShebang t] getCandidates (T_Annotation _ annotations s) = map forAnnotation annotations ++ [Just $ fromShebang s] @@ -252,7 +252,7 @@ isParamTo tree cmd = getClosestCommand tree t = msum . map getCommand $ getPath tree t where - getCommand t@(T_Redirecting {}) = return t + getCommand t@T_Redirecting {} = return t getCommand _ = Nothing getClosestCommandM t = do @@ -319,8 +319,8 @@ getVariableFlow shell parents t = unless (assignFirst t) $ setWritten t when (scopeType /= NoneScope) $ modify (StackScopeEnd:) - assignFirst (T_ForIn {}) = True - assignFirst (T_SelectIn {}) = True + assignFirst T_ForIn {} = True + assignFirst T_SelectIn {} = True assignFirst _ = False setRead t = @@ -374,7 +374,7 @@ getModifiedVariables t = [(x, x, name, dataTypeFrom DataString w)] _ -> [] ) vars - c@(T_SimpleCommand {}) -> + c@T_SimpleCommand {} -> getModifiedVariableCommand c TA_Unary _ "++|" var -> maybeToList $ do @@ -401,7 +401,7 @@ getModifiedVariables t = [(t, t, fromMaybe "COPROC" name, DataArray SourceInteger)] --Points to 'for' rather than variable - T_ForIn id str [] _ -> [(t, t, str, DataString $ SourceExternal)] + T_ForIn id str [] _ -> [(t, t, str, DataString SourceExternal)] T_ForIn id str words _ -> [(t, t, str, DataString $ SourceFrom words)] T_SelectIn id str words _ -> [(t, t, str, DataString $ SourceFrom words)] _ -> [] @@ -496,7 +496,7 @@ getModifiedVariableCommand base@(T_SimpleCommand _ _ (T_NormalWord _ (T_Literal getModifierParam def t@(T_Assignment _ _ name _ value) = [(base, t, name, dataTypeFrom def value)] - getModifierParam def t@(T_NormalWord {}) = maybeToList $ do + getModifierParam def t@T_NormalWord {} = maybeToList $ do name <- getLiteralString t guard $ isVariableName name return (base, t, name, def SourceDeclaration) @@ -584,7 +584,7 @@ getReferencedVariables parents t = getVariablesFromLiteralToken word else [] - literalizer (TA_Index {}) = return "" -- x[0] becomes a reference of x + literalizer TA_Index {} = return "" -- x[0] becomes a reference of x literalizer _ = Nothing getIfReference context token = maybeToList $ do @@ -717,7 +717,7 @@ filterByAnnotation token = where hasNum (DisableComment ts) = num == ts hasNum _ = False - shouldIgnoreFor _ (T_Include {}) = True -- Ignore included files + shouldIgnoreFor _ T_Include {} = True -- Ignore included files shouldIgnoreFor _ _ = False parents = getParentTree token getCode (TokenComment _ (Comment _ c _)) = c diff --git a/ShellCheck/Interface.hs b/ShellCheck/Interface.hs index 6662a1e..861be12 100644 --- a/ShellCheck/Interface.hs +++ b/ShellCheck/Interface.hs @@ -24,7 +24,7 @@ import Control.Monad.Identity import qualified Data.Map as Map -data SystemInterface m = SystemInterface { +newtype SystemInterface m = SystemInterface { -- Read a file by filename, or return an error siReadFile :: String -> m (Either ErrorMessage String) } @@ -42,6 +42,7 @@ data CheckResult = CheckResult { crComments :: [PositionedComment] } deriving (Show, Eq) +emptyCheckSpec :: CheckSpec emptyCheckSpec = CheckSpec { csFilename = "", csScript = "", @@ -68,13 +69,13 @@ data AnalysisSpec = AnalysisSpec { asExecutionMode :: ExecutionMode } -data AnalysisResult = AnalysisResult { +newtype AnalysisResult = AnalysisResult { arComments :: [TokenComment] } -- Formatter options -data FormatterOptions = FormatterOptions { +newtype FormatterOptions = FormatterOptions { foColorOption :: ColorOption }