From 72eeafe002929a6547a928ac359285e4e4af8651 Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Sat, 15 Aug 2015 09:34:19 -0700 Subject: [PATCH] Some cleanup to make room for future improvements. --- ShellCheck.cabal | 15 +- ShellCheck/Analytics.hs | 135 +++++++++++------- ShellCheck/Analyzer.hs | 27 ++++ ShellCheck/Checker.hs | 124 ++++++++++++++++ ShellCheck/Data.hs | 13 ++ ShellCheck/Interface.hs | 99 +++++++++++++ ShellCheck/Options.hs | 14 -- ShellCheck/Parser.hs | 164 ++++++++++++++------- ShellCheck/Simple.hs | 82 ----------- shellcheck.hs | 308 +++++++++++++++++++++++----------------- test/shellcheck.hs | 16 ++- 11 files changed, 649 insertions(+), 348 deletions(-) create mode 100644 ShellCheck/Analyzer.hs create mode 100644 ShellCheck/Checker.hs create mode 100644 ShellCheck/Interface.hs delete mode 100644 ShellCheck/Options.hs delete mode 100644 ShellCheck/Simple.hs diff --git a/ShellCheck.cabal b/ShellCheck.cabal index 0a751a6..9990531 100644 --- a/ShellCheck.cabal +++ b/ShellCheck.cabal @@ -41,18 +41,19 @@ library containers, directory, json, - mtl, + mtl >= 2.2.1, parsec, regex-tdfa, QuickCheck >= 2.7.4 exposed-modules: + ShellCheck.Checker + ShellCheck.Analyzer + ShellCheck.Parser ShellCheck.Analytics ShellCheck.AST ShellCheck.Data - ShellCheck.Options - ShellCheck.Parser + ShellCheck.Interface ShellCheck.Regex - ShellCheck.Simple other-modules: Paths_ShellCheck @@ -63,10 +64,9 @@ executable shellcheck containers, directory, json, - mtl, + mtl >= 2.2.1, parsec, regex-tdfa, - transformers, QuickCheck >= 2.7.4 main-is: shellcheck.hs @@ -78,10 +78,9 @@ test-suite test-shellcheck containers, directory, json, - mtl, + mtl >= 2.2.1, parsec, regex-tdfa, - transformers, QuickCheck >= 2.7.4 main-is: test/shellcheck.hs diff --git a/ShellCheck/Analytics.hs b/ShellCheck/Analytics.hs index 4eee9e5..b39b2f8 100644 --- a/ShellCheck/Analytics.hs +++ b/ShellCheck/Analytics.hs @@ -18,10 +18,17 @@ along with this program. If not, see . -} {-# LANGUAGE TemplateHaskell, FlexibleContexts #-} -module ShellCheck.Analytics (AnalysisOptions(..), defaultAnalysisOptions, filterByAnnotation, runAnalytics, shellForExecutable, runTests) where +module ShellCheck.Analytics (runAnalytics, ShellCheck.Analytics.runTests) where + +import ShellCheck.AST +import ShellCheck.Data +import ShellCheck.Parser +import ShellCheck.Interface +import ShellCheck.Regex import Control.Arrow (first) import Control.Monad +import Control.Monad.Identity import Control.Monad.State import Control.Monad.Writer import Data.Char @@ -31,11 +38,6 @@ import Data.List import Data.Maybe import Data.Ord import Debug.Trace -import ShellCheck.AST -import ShellCheck.Options -import ShellCheck.Data -import ShellCheck.Parser hiding (runTests) -import ShellCheck.Regex import qualified Data.Map as Map import Test.QuickCheck.All (forAllProperties) import Test.QuickCheck.Test (quickCheckWithResult, stdArgs, maxSuccess) @@ -48,7 +50,7 @@ data Parameters = Parameters { } -- Checks that are run on the AST root -treeChecks :: [Parameters -> Token -> [Note]] +treeChecks :: [Parameters -> Token -> [TokenComment]] treeChecks = [ runNodeAnalysis (\p t -> (mapM_ ((\ f -> f t) . (\ f -> f p)) @@ -81,19 +83,28 @@ checksFor Bash = [ ,checkForDecimals ] -runAnalytics :: AnalysisOptions -> Token -> [Note] -runAnalytics options root = runList options root treeChecks +runAnalytics :: AnalysisSpec -> AnalysisResult +runAnalytics options = AnalysisResult { + arComments = + nub . filterByAnnotation (asScript options) $ + runList options treeChecks + } -runList options root list = notes +runList :: AnalysisSpec -> [Parameters -> Token -> [TokenComment]] + -> [TokenComment] +runList spec list = notes where + root = asScript spec params = Parameters { - shellType = fromMaybe (determineShell root) $ optionShellType options, - shellTypeSpecified = isJust $ optionShellType options, + shellType = fromMaybe (determineShell root) $ asShellType spec, + shellTypeSpecified = isJust $ asShellType spec, parentMap = getParentTree root, - variableFlow = getVariableFlow (shellType params) (parentMap params) root + variableFlow = + getVariableFlow (shellType params) (parentMap params) root } - notes = filter (\c -> getCode c `notElem` optionExcludes options) $ concatMap (\f -> f params root) list - getCode (Note _ _ c _) = c + notes = concatMap (\f -> f params root) list + +getCode (TokenComment _ (Comment _ c _)) = c checkList l t = concatMap (\f -> f t) l @@ -107,21 +118,10 @@ determineShell (T_Script _ shebang _) = fromMaybe Bash . shellForExecutable $ sh shellFor s | ' ' `elem` s = shellFor $ takeWhile (/= ' ') s shellFor s = reverse . takeWhile (/= '/') . reverse $ s -shellForExecutable "sh" = return Sh -shellForExecutable "ash" = return Sh -shellForExecutable "dash" = return Sh - -shellForExecutable "ksh" = return Ksh -shellForExecutable "ksh88" = return Ksh -shellForExecutable "ksh93" = return Ksh - -shellForExecutable "bash" = return Bash -shellForExecutable _ = Nothing - -- Checks that are run on each node in the AST runNodeAnalysis f p t = execWriter (doAnalysis (f p) t) -nodeChecks :: [Parameters -> Token -> Writer [Note] ()] +nodeChecks :: [Parameters -> Token -> Writer [TokenComment] ()] nodeChecks = [ checkUuoc ,checkPipePitfalls @@ -216,10 +216,9 @@ nodeChecks = [ filterByAnnotation token = filter (not . shouldIgnore) where - numFor (Note _ _ code _) = code - idFor (Note id _ _ _) = id + idFor (TokenComment id _) = id shouldIgnore note = - any (shouldIgnoreFor (numFor note)) $ + any (shouldIgnoreFor (getCode note)) $ getPath parents (T_Bang $ idFor note) shouldIgnoreFor num (T_Annotation _ anns _) = any hasNum anns @@ -228,12 +227,17 @@ filterByAnnotation token = shouldIgnoreFor _ _ = False parents = getParentTree token -addNote note = tell [note] -makeNote severity id code note = addNote $ Note id severity code note -warn = makeNote WarningC -err = makeNote ErrorC -info = makeNote InfoC -style = makeNote StyleC +makeComment :: Severity -> Id -> Code -> String -> TokenComment +makeComment severity id code note = + TokenComment id $ Comment severity code note + +addComment note = tell [note] + +warn :: MonadWriter [TokenComment] m => Id -> Code -> String -> m () +warn id code str = addComment $ makeComment WarningC id code str +err id code str = addComment $ makeComment ErrorC id code str +info id code str = addComment $ makeComment InfoC id code str +style id code str = addComment $ makeComment StyleC id code str isVariableStartChar x = x == '_' || isAsciiLower x || isAsciiUpper x isVariableChar x = isVariableStartChar x || isDigit x @@ -343,23 +347,33 @@ getLeadingFlags = getFlagsUntil (not . ("-" `isPrefixOf`)) [] -> Nothing (r:_) -> Just r -verify :: (Parameters -> Token -> Writer [Note] ()) -> String -> Bool +verify :: (Parameters -> Token -> Writer [TokenComment] ()) -> String -> Bool verify f s = checkNode f s == Just True -verifyNot :: (Parameters -> Token -> Writer [Note] ()) -> String -> Bool +verifyNot :: (Parameters -> Token -> Writer [TokenComment] ()) -> String -> Bool verifyNot f s = checkNode f s == Just False -verifyTree :: (Parameters -> Token -> [Note]) -> String -> Bool -verifyTree f s = checkTree f s == Just True +verifyTree :: (Parameters -> Token -> [TokenComment]) -> String -> Bool +verifyTree f s = producesComments f s == Just True -verifyNotTree :: (Parameters -> Token -> [Note]) -> String -> Bool -verifyNotTree f s = checkTree f s == Just False +verifyNotTree :: (Parameters -> Token -> [TokenComment]) -> String -> Bool +verifyNotTree f s = producesComments f s == Just False -checkNode f = checkTree (runNodeAnalysis f) -checkTree f s = case parseShell defaultAnalysisOptions "-" s of - (ParseResult (Just (t, m)) _) -> Just . not . null $ runList defaultAnalysisOptions t [f] - _ -> Nothing +defaultSpec root = AnalysisSpec { + asScript = root, + asShellType = Nothing, + asExecutionMode = Executed +} + +checkNode f = producesComments (runNodeAnalysis f) +producesComments :: (Parameters -> Token -> [TokenComment]) -> String -> Maybe Bool +producesComments f s = do + root <- prRoot pResult + return . not . null $ runList (defaultSpec root) [f] + where + pSpec = ParseSpec { psScript = s } + pResult = runIdentity $ parseScript (mockedSystemInterface []) pSpec -- Copied from https://wiki.haskell.org/Edit_distance dist :: Eq a => [a] -> [a] -> Int @@ -628,13 +642,13 @@ mayBecomeMultipleArgs t = willBecomeMultipleArgs t || f t prop_checkShebangParameters1 = verifyTree checkShebangParameters "#!/usr/bin/env bash -x\necho cow" prop_checkShebangParameters2 = verifyNotTree checkShebangParameters "#! /bin/sh -l " checkShebangParameters _ (T_Script id sb _) = - [Note id ErrorC 2096 "On most OS, shebangs can only specify a single parameter." | length (words sb) > 2] + [makeComment ErrorC id 2096 "On most OS, shebangs can only specify a single parameter." | length (words sb) > 2] prop_checkShebang1 = verifyNotTree checkShebang "#!/usr/bin/env bash -x\necho cow" prop_checkShebang2 = verifyNotTree checkShebang "#! /bin/sh -l " prop_checkShebang3 = verifyTree checkShebang "ls -l" checkShebang params (T_Script id sb _) = - [Note id ErrorC 2148 "Tips depend on target shell and yours is unknown. Add a shebang." + [makeComment ErrorC id 2148 "Tips depend on target shell and yours is unknown. Add a shebang." | not (shellTypeSpecified params) && sb == "" ] prop_checkBashisms = verify checkBashisms "while read a; do :; done < <(a)" @@ -901,15 +915,15 @@ prop_checkRedirectToSame5 = verifyNot checkRedirectToSame "foo > bar 2> bar" checkRedirectToSame params s@(T_Pipeline _ _ list) = mapM_ (\l -> (mapM_ (\x -> doAnalysis (checkOccurrences x) l) (getAllRedirs list))) list where - note x = Note x InfoC 2094 + note x = makeComment InfoC x 2094 "Make sure not to read and write the same file in the same pipeline." checkOccurrences t@(T_NormalWord exceptId x) u@(T_NormalWord newId y) = when (exceptId /= newId && x == y && not (isOutput t && isOutput u) && not (special t)) $ do - addNote $ note newId - addNote $ note exceptId + addComment $ note newId + addComment $ note exceptId checkOccurrences _ _ = return () getAllRedirs = concatMap (\t -> case t of @@ -1028,7 +1042,7 @@ checkArrayWithoutIndex params _ = return . maybeToList $ do name <- getLiteralString token assignment <- Map.lookup name map - return [Note id WarningC 2128 + return [makeComment WarningC id 2128 "Expanding an array without an index only gives the first element."] readF _ _ _ = return [] @@ -2495,6 +2509,17 @@ findSubshelled (StackScopeEnd:rest) ((reason, scope):oldScopes) deadVars = foldl (\m (_, token, var, _) -> Map.insert var (Dead token reason) m) deadVars scope + +-- FIXME: This is a very strange way of doing it. +-- For each variable read/write, run a stateful function that emits +-- comments. The comments are collected and returned. +doVariableFlowAnalysis :: + (Token -> Token -> String -> State t [v]) + -> (Token -> Token -> String -> DataType -> State t [v]) + -> t + -> [StackData] + -> [v] + doVariableFlowAnalysis readFunc writeFunc empty flow = evalState ( foldM (\list x -> do { l <- doFlow x; return $ l ++ list; }) [] flow ) empty @@ -2548,7 +2573,7 @@ checkSpacefulness params t = readF _ token name = do spaced <- hasSpaces name - return [Note (getId token) InfoC 2086 warning | + return [makeComment InfoC (getId token) 2086 warning | spaced && not (isArrayExpansion token) -- There's another warning for this && not (isCounting token) @@ -2652,9 +2677,9 @@ checkQuotesInLiterals params t = && not (isParamTo parents "eval" expr) && not (isQuoteFree parents expr) then [ - Note (fromJust assignment)WarningC 2089 + makeComment WarningC (fromJust assignment) 2089 "Quotes/backslashes will be treated literally. Use an array.", - Note (getId expr) WarningC 2090 + makeComment WarningC (getId expr) 2090 "Quotes/backslashes in this variable will not be respected." ] else []) diff --git a/ShellCheck/Analyzer.hs b/ShellCheck/Analyzer.hs new file mode 100644 index 0000000..1363065 --- /dev/null +++ b/ShellCheck/Analyzer.hs @@ -0,0 +1,27 @@ +{- + Copyright 2012-2015 Vidar Holen + + This file is part of ShellCheck. + http://www.vidarholen.net/contents/shellcheck + + ShellCheck is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + ShellCheck is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +module ShellCheck.Analyzer (analyzeScript) where + +import ShellCheck.Interface +import ShellCheck.Analytics + +-- TODO: Clean up the cruft this is layered on +analyzeScript :: AnalysisSpec -> AnalysisResult +analyzeScript = runAnalytics diff --git a/ShellCheck/Checker.hs b/ShellCheck/Checker.hs new file mode 100644 index 0000000..7700c56 --- /dev/null +++ b/ShellCheck/Checker.hs @@ -0,0 +1,124 @@ +{- + Copyright 2012-2015 Vidar Holen + + This file is part of ShellCheck. + http://www.vidarholen.net/contents/shellcheck + + ShellCheck is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + ShellCheck is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +{-# LANGUAGE TemplateHaskell #-} +module ShellCheck.Checker (checkScript, ShellCheck.Checker.runTests) where + +import ShellCheck.Interface +import ShellCheck.Parser +import ShellCheck.Analyzer + +import Data.Either +import Data.Functor +import Data.List +import Data.Maybe +import Data.Ord +import Control.Monad.Identity +import qualified Data.Map as Map +import qualified System.IO +import Prelude hiding (readFile) +import Control.Monad + +import Test.QuickCheck.All + +tokenToPosition map (TokenComment id c) = fromMaybe fail $ do + position <- Map.lookup id map + return $ PositionedComment position c + where + fail = error "Internal shellcheck error: id doesn't exist. Please report!" + +checkScript :: Monad m => SystemInterface m -> CheckSpec -> m CheckResult +checkScript sys spec = do + results <- checkScript (csScript spec) + return CheckResult { + crComments = results + } + where + checkScript contents = do + result <- parseScript sys ParseSpec { psScript = contents } + let parseMessages = prComments result + let analysisMessages = + fromMaybe [] $ + (arComments . analyzeScript . analysisSpec) + <$> prRoot result + let translator = tokenToPosition (prTokenPositions result) + return . sortMessages . filter shouldInclude $ + (parseMessages ++ map translator analysisMessages) + + shouldInclude (PositionedComment _ (Comment _ code _)) = + code `notElem` csExcludedWarnings spec + + sortMessages = sortBy (comparing order) + order (PositionedComment pos (Comment severity code message)) = + (posFile pos, posLine pos, posColumn pos, code, message) + getPosition (PositionedComment pos _) = pos + + analysisSpec root = + AnalysisSpec { + asScript = root, + asShellType = csShellTypeOverride spec, + asExecutionMode = Executed + } + +getErrors sys spec = + map getCode . crComments $ + runIdentity (checkScript sys spec) + where + getCode (PositionedComment _ (Comment _ code _)) = code + +check str = + getErrors + (mockedSystemInterface []) + emptyCheckSpec { + csScript = str, + csExcludedWarnings = [2148] + } + +prop_findsParseIssue = check "echo \"$12\"" == [1037] + +prop_commentDisablesParseIssue1 = + null $ check "#shellcheck disable=SC1037\necho \"$12\"" +prop_commentDisablesParseIssue2 = + null $ check "#shellcheck disable=SC1037\n#lol\necho \"$12\"" + +prop_findsAnalysisIssue = + check "echo $1" == [2086] +prop_commentDisablesAnalysisIssue1 = + null $ check "#shellcheck disable=SC2086\necho $1" +prop_commentDisablesAnalysisIssue2 = + null $ check "#shellcheck disable=SC2086\n#lol\necho $1" + +prop_optionDisablesIssue1 = + null $ getErrors + (mockedSystemInterface []) + emptyCheckSpec { + csScript = "echo $1", + csExcludedWarnings = [2148, 2086] + } + +prop_optionDisablesIssue2 = + null $ getErrors + (mockedSystemInterface []) + emptyCheckSpec { + csScript = "echo \"$10\"", + csExcludedWarnings = [2148, 1037] + } + +return [] +runTests = $quickCheckAll diff --git a/ShellCheck/Data.hs b/ShellCheck/Data.hs index 39af73f..bcbf0dc 100644 --- a/ShellCheck/Data.hs +++ b/ShellCheck/Data.hs @@ -1,5 +1,6 @@ module ShellCheck.Data where +import ShellCheck.Interface import Data.Version (showVersion) import Paths_ShellCheck (version) @@ -73,3 +74,15 @@ sampleWords = [ "tango", "uniform", "victor", "whiskey", "xray", "yankee", "zulu" ] + +shellForExecutable :: String -> Maybe Shell +shellForExecutable "sh" = return Sh +shellForExecutable "ash" = return Sh +shellForExecutable "dash" = return Sh + +shellForExecutable "ksh" = return Ksh +shellForExecutable "ksh88" = return Ksh +shellForExecutable "ksh93" = return Ksh + +shellForExecutable "bash" = return Bash +shellForExecutable _ = Nothing diff --git a/ShellCheck/Interface.hs b/ShellCheck/Interface.hs new file mode 100644 index 0000000..6616915 --- /dev/null +++ b/ShellCheck/Interface.hs @@ -0,0 +1,99 @@ +{- + Copyright 2012-2015 Vidar Holen + + This file is part of ShellCheck. + http://www.vidarholen.net/contents/shellcheck + + ShellCheck is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + ShellCheck is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +-} +module ShellCheck.Interface where + +import ShellCheck.AST +import Control.Monad.Identity +import qualified Data.Map as Map + + +data SystemInterface m = SystemInterface { + -- Read a file by filename, or return an error + siReadFile :: String -> m (Either ErrorMessage String) +} + +-- ShellCheck input and output +data CheckSpec = CheckSpec { + csScript :: String, + csExcludedWarnings :: [Integer], + csShellTypeOverride :: Maybe Shell +} deriving (Show, Eq) + +data CheckResult = CheckResult { + crComments :: [PositionedComment] +} deriving (Show, Eq) + +emptyCheckSpec = CheckSpec { + csScript = "", + csExcludedWarnings = [], + csShellTypeOverride = Nothing +} + +-- Parser input and output +data ParseSpec = ParseSpec { + psScript :: String +} deriving (Show, Eq) + +data ParseResult = ParseResult { + prComments :: [PositionedComment], + prTokenPositions :: Map.Map Id Position, + prRoot :: Maybe Token +} deriving (Show, Eq) + +-- Analyzer input and output +data AnalysisSpec = AnalysisSpec { + asScript :: Token, + asShellType :: Maybe Shell, + asExecutionMode :: ExecutionMode +} + +data AnalysisResult = AnalysisResult { + arComments :: [TokenComment] +} + +-- Supporting data types +data Shell = Ksh | Sh | Bash deriving (Show, Eq) +data ExecutionMode = Executed | Sourced deriving (Show, Eq) + +type ErrorMessage = String +type Code = Integer + +data Severity = ErrorC | WarningC | InfoC | StyleC deriving (Show, Eq, Ord) +data Position = Position { + posFile :: String, -- Filename + posLine :: Integer, -- 1 based source line + posColumn :: Integer -- 1 based source column, where tabs are 8 +} deriving (Show, Eq) + +data Comment = Comment Severity Code String deriving (Show, Eq) +data PositionedComment = PositionedComment Position Comment deriving (Show, Eq) +data TokenComment = TokenComment Id Comment deriving (Show, Eq) + +-- For testing +mockedSystemInterface :: [(String, String)] -> SystemInterface Identity +mockedSystemInterface files = SystemInterface { + siReadFile = rf +} + where + rf file = + case filter ((== file) . fst) files of + [] -> return $ Left "File not included in mock." + [(_, contents)] -> return $ Right contents + diff --git a/ShellCheck/Options.hs b/ShellCheck/Options.hs deleted file mode 100644 index 5966e4a..0000000 --- a/ShellCheck/Options.hs +++ /dev/null @@ -1,14 +0,0 @@ -module ShellCheck.Options where - -data Shell = Ksh | Sh | Bash - deriving (Show, Eq) - -data AnalysisOptions = AnalysisOptions { - optionShellType :: Maybe Shell, - optionExcludes :: [Integer] -} - -defaultAnalysisOptions = AnalysisOptions { - optionShellType = Nothing, - optionExcludes = [] -} diff --git a/ShellCheck/Parser.hs b/ShellCheck/Parser.hs index ed38474..666d376 100644 --- a/ShellCheck/Parser.hs +++ b/ShellCheck/Parser.hs @@ -18,19 +18,21 @@ along with this program. If not, see . -} {-# LANGUAGE NoMonomorphismRestriction, TemplateHaskell, FlexibleContexts #-} -module ShellCheck.Parser (Note(..), Severity(..), parseShell, ParseResult(..), ParseNote(..), sortNotes, noteToParseNote, runTests, readScript) where +module ShellCheck.Parser (parseScript, runTests) where import ShellCheck.AST import ShellCheck.Data -import ShellCheck.Options -import Text.Parsec +import ShellCheck.Interface +import Text.Parsec hiding (runParser) import Debug.Trace import Control.Monad -import Control.Arrow (first) +import Control.Monad.Identity import Data.Char +import Data.Functor import Data.List (isPrefixOf, isInfixOf, isSuffixOf, partition, sortBy, intercalate, nub) import qualified Data.Map as Map import qualified Control.Monad.State as Ms +import qualified Control.Monad.Reader as Mr import Data.Maybe import Prelude hiding (readList) import System.IO @@ -38,6 +40,10 @@ import Text.Parsec.Error import GHC.Exts (sortWith) import Test.QuickCheck.All (quickCheckAll) +type SCBase m = Mr.ReaderT (SystemInterface m) (Ms.StateT SystemState m) +type SCParser m v = ParsecT String UserState (SCBase m) v + +backslash :: Monad m => SCParser m Char backslash = char '\\' linefeed = optional carriageReturn >> char '\n' singleQuote = char '\'' <|> unicodeSingleQuote @@ -119,9 +125,18 @@ almostSpace = --------- Message/position annotation on top of user state data Note = Note Id Severity Code String deriving (Show, Eq) data ParseNote = ParseNote SourcePos Severity Code String deriving (Show, Eq) -data Severity = ErrorC | WarningC | InfoC | StyleC deriving (Show, Eq, Ord) data Context = ContextName SourcePos String | ContextAnnotation [Annotation] deriving (Show) -type Code = Integer + +data UserState = UserState { + lastId :: Id, + positionMap :: Map.Map Id SourcePos, + parseNotes :: [ParseNote] +} +initialUserState = UserState { + lastId = Id $ -1, + positionMap = Map.empty, + parseNotes = [] +} codeForParseNote (ParseNote _ _ code _) = code noteToParseNote map (Note id severity code message) = @@ -129,17 +144,17 @@ noteToParseNote map (Note id severity code message) = where pos = fromJust $ Map.lookup id map -initialState = (Id $ -1, Map.empty, []) -getLastId = do - (id, _, _) <- getState - return id +getLastId = lastId <$> getState getNextIdAt sourcepos = do - (id, map, notes) <- getState - let newId = incId id - let newMap = Map.insert newId sourcepos map - putState (newId, newMap, notes) + state <- getState + let newId = incId (lastId state) + let newMap = Map.insert newId sourcepos (positionMap state) + putState $ state { + lastId = newId, + positionMap = newMap + } return newId where incId (Id n) = Id $ n+1 @@ -147,23 +162,16 @@ getNextId = do pos <- getPosition getNextIdAt pos -modifyMap f = do - (id, map, parsenotes) <- getState - putState (id, f map, parsenotes) - -getMap = do - (_, map, _) <- getState - return map - -getParseNotes = do - (_, _, notes) <- getState - return notes +getMap = positionMap <$> getState +getParseNotes = parseNotes <$> getState addParseNote n = do irrelevant <- shouldIgnoreCode (codeForParseNote n) unless irrelevant $ do - (a, b, notes) <- getState - putState (a, b, n:notes) + state <- getState + putState $ state { + parseNotes = n : parseNotes state + } shouldIgnoreCode code = do context <- getCurrentContexts @@ -175,16 +183,22 @@ shouldIgnoreCode code = do disabling' (DisableComment n) = code == n -- Store potential parse problems outside of parsec + +data SystemState = SystemState { + contextStack :: [Context], + parseProblems :: [ParseNote] +} +initialSystemState = SystemState { + contextStack = [], + parseProblems = [] +} + parseProblem level code msg = do pos <- getPosition parseProblemAt pos level code msg -setCurrentContexts c = - Ms.modify (\(list, _) -> (list, c)) - -getCurrentContexts = do - (_, context) <- Ms.get - return context +setCurrentContexts c = Ms.modify (\state -> state { contextStack = c }) +getCurrentContexts = contextStack <$> Ms.get popContext = do v <- getCurrentContexts @@ -203,7 +217,11 @@ pushContext c = do parseProblemAt pos level code msg = do irrelevant <- shouldIgnoreCode code unless irrelevant $ - Ms.modify (first ((:) (ParseNote pos level code msg))) + Ms.modify (\state -> state { + parseProblems = note:parseProblems state + }) + where + note = ParseNote pos level code msg -- Store non-parse problems inside @@ -2152,15 +2170,17 @@ readScript = do readUtf8Bom = called "Byte Order Mark" $ string "\xFEFF" -rp p filename contents = Ms.runState (runParserT p initialState filename contents) ([], []) -isWarning p s = fst cs && (not . null . snd $ cs) where cs = checkString p s -isOk p s = fst cs && (null . snd $ cs) where cs = checkString p s +isWarning p s = parsesCleanly p s == Just False +isOk p s = parsesCleanly p s == Just True -checkString parser string = - case rp (parser >> eof >> getState) "-" string of - (Right (tree, map, notes), (problems, _)) -> (True, notes ++ problems) - (Left _, (n, _)) -> (False, n) +parsesCleanly parser string = runIdentity $ do + (res, sys) <- runParser (mockedSystemInterface []) + (parser >> eof >> getState) "-" string + case (res, sys) of + (Right userState, systemState) -> + return $ Just . null $ parseNotes userState ++ parseProblems systemState + (Left _, _) -> return Nothing parseWithNotes parser = do item <- parser @@ -2172,8 +2192,6 @@ compareNotes (ParseNote pos1 level1 _ s1) (ParseNote pos2 level2 _ s2) = compare sortNotes = sortBy compareNotes -data ParseResult = ParseResult { parseResult :: Maybe (Token, Map.Map Id SourcePos), parseNotes :: [ParseNote] } deriving (Show) - makeErrorFor parsecError = ParseNote (errorPos parsecError) ErrorC 1072 $ getStringFromParsec $ errorMessages parsecError @@ -2191,13 +2209,39 @@ getStringFromParsec errors = Message s -> if null s then Nothing else return $ s ++ "." unexpected s = "Unexpected " ++ (if null s then "eof" else s) ++ "." -parseShell options filename contents = - case rp (parseWithNotes readScript) filename contents of - (Right (script, map, notes), (parsenotes, _)) -> - ParseResult (Just (script, map)) (nub . sortNotes . excludeNotes $ notes ++ parsenotes) - (Left err, (p, context)) -> - ParseResult Nothing - (nub . sortNotes . excludeNotes $ p ++ notesForContext context ++ [makeErrorFor err]) +runParser :: Monad m => + SystemInterface m -> + SCParser m v -> + String -> + String -> + m (Either ParseError v, SystemState) + +runParser sys p filename contents = + Ms.runStateT + (Mr.runReaderT + (runParserT p initialUserState filename contents) + sys) + initialSystemState + +parseShell sys contents = do + (result, state) <- runParser sys (parseWithNotes readScript) "" contents + case result of + Right (script, tokenMap, notes) -> + return ParseResult { + prComments = map toPositionedComment $ nub $ notes ++ parseProblems state, + prTokenPositions = Map.map posToPos tokenMap, + prRoot = Just script + } + Left err -> + return ParseResult { + prComments = + map toPositionedComment $ + notesForContext (contextStack state) + ++ [makeErrorFor err] + ++ parseProblems state, + prTokenPositions = Map.empty, + prRoot = Nothing + } where isName (ContextName _ _) = True isName _ = False @@ -2206,7 +2250,25 @@ parseShell options filename contents = "Couldn't parse this " ++ str ++ "." second (ContextName pos str) = ParseNote pos InfoC 1009 $ "The mentioned parser error was in this " ++ str ++ "." - excludeNotes = filter (\c -> codeForParseNote c `notElem` optionExcludes options) + + +toPositionedComment :: ParseNote -> PositionedComment +toPositionedComment (ParseNote pos severity code message) = + PositionedComment (posToPos pos) $ Comment severity code message + +posToPos :: SourcePos -> Position +posToPos sp = Position { + posFile = sourceName sp, + posLine = fromIntegral $ sourceLine sp, + posColumn = fromIntegral $ sourceColumn sp +} + +-- TODO: Clean up crusty old code that this is layered on top of +parseScript :: Monad m => + SystemInterface m -> ParseSpec -> m ParseResult +parseScript sys spec = + parseShell sys (psScript spec) + lt x = trace (show x) x ltt t = trace (show t) diff --git a/ShellCheck/Simple.hs b/ShellCheck/Simple.hs deleted file mode 100644 index 4746a4c..0000000 --- a/ShellCheck/Simple.hs +++ /dev/null @@ -1,82 +0,0 @@ -{- - Copyright 2012-2015 Vidar Holen - - This file is part of ShellCheck. - http://www.vidarholen.net/contents/shellcheck - - ShellCheck is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - ShellCheck is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see . --} -{-# LANGUAGE TemplateHaskell #-} -module ShellCheck.Simple (shellCheck, ShellCheckComment, scLine, scColumn, scSeverity, scCode, scMessage, runTests) where - -import Data.List -import Data.Maybe -import ShellCheck.Analytics hiding (runTests) -import ShellCheck.Options -import ShellCheck.Parser hiding (runTests) -import Test.QuickCheck.All (quickCheckAll) -import Text.Parsec.Pos - -shellCheck :: AnalysisOptions -> String -> [ShellCheckComment] -shellCheck options script = - let (ParseResult result notes) = parseShell options "-" script in - let allNotes = notes ++ concat (maybeToList $ do - (tree, posMap) <- result - let list = runAnalytics options tree - return $ map (noteToParseNote posMap) $ filterByAnnotation tree list - ) - in - map formatNote $ nub $ sortNotes allNotes - -data ShellCheckComment = ShellCheckComment { scLine :: Int, scColumn :: Int, scSeverity :: String, scCode :: Int, scMessage :: String } - -instance Show ShellCheckComment where - show c = concat ["(", show $ scLine c, ",", show $ scColumn c, ") ", scSeverity c, ": ", show (scCode c), " ", scMessage c] - -severityToString s = - case s of - ErrorC -> "error" - WarningC -> "warning" - InfoC -> "info" - StyleC -> "style" - -formatNote (ParseNote pos severity code text) = - ShellCheckComment (sourceLine pos) (sourceColumn pos) (severityToString severity) (fromIntegral code) text - -testCheck = shellCheck defaultAnalysisOptions { optionExcludes = [2148] } -- Ignore #! warnings -prop_findsParseIssue = - let comments = testCheck "echo \"$12\"" in - length comments == 1 && scCode (head comments) == 1037 -prop_commentDisablesParseIssue1 = - null $ testCheck "#shellcheck disable=SC1037\necho \"$12\"" -prop_commentDisablesParseIssue2 = - null $ testCheck "#shellcheck disable=SC1037\n#lol\necho \"$12\"" - -prop_findsAnalysisIssue = - let comments = testCheck "echo $1" in - length comments == 1 && scCode (head comments) == 2086 -prop_commentDisablesAnalysisIssue1 = - null $ testCheck "#shellcheck disable=SC2086\necho $1" -prop_commentDisablesAnalysisIssue2 = - null $ testCheck "#shellcheck disable=SC2086\n#lol\necho $1" - -prop_optionDisablesIssue1 = - null $ shellCheck (defaultAnalysisOptions { optionExcludes = [2086, 2148] }) "echo $1" - -prop_optionDisablesIssue2 = - null $ shellCheck (defaultAnalysisOptions { optionExcludes = [2148, 1037] }) "echo \"$10\"" - -return [] -runTests = $quickCheckAll - diff --git a/shellcheck.hs b/shellcheck.hs index 6bea5e2..130d1d9 100644 --- a/shellcheck.hs +++ b/shellcheck.hs @@ -17,43 +17,59 @@ 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 Control.Exception import Control.Monad -import Control.Monad.Trans -import Control.Monad.Trans.Error -import Control.Monad.Trans.List +import Control.Monad.Except import Data.Char +import Data.Functor +import Data.Either +import Data.IORef import Data.List +import qualified Data.Map as Map import Data.Maybe import Data.Monoid import GHC.Exts import GHC.IO.Device import Prelude hiding (catch) -import ShellCheck.Data -import ShellCheck.Options -import ShellCheck.Simple -import ShellCheck.Analytics import System.Console.GetOpt -import System.Directory import System.Environment import System.Exit -import System.Info import System.IO +import System.Info import Text.JSON import qualified Data.Map as Map data Flag = Flag String String -data Status = NoProblems | SomeProblems | BadInput | SupportFailure | SyntaxFailure | RuntimeException deriving (Ord, Eq) - -data JsonComment = JsonComment FilePath ShellCheckComment - -instance Error Status where - noMsg = RuntimeException +data Status = + NoProblems + | SomeProblems + | BadInput + | SupportFailure + | SyntaxFailure + | RuntimeException + deriving (Ord, Eq) instance Monoid Status where mempty = NoProblems mappend = max +lineNo (PositionedComment pos _) = posLine pos +colNo (PositionedComment pos _) = posColumn pos +codeNo (PositionedComment _ (Comment _ code _)) = code +messageText (PositionedComment _ (Comment _ _ t)) = t + +severityText :: PositionedComment -> String +severityText (PositionedComment _ (Comment c _ _)) = + case c of + ErrorC -> "error" + WarningC -> "warning" + InfoC -> "info" + StyleC -> "style" + header = "Usage: shellcheck [OPTIONS...] FILES..." options = [ Option "e" ["exclude"] @@ -66,51 +82,42 @@ options = [ (NoArg $ Flag "version" "true") "Print version information" ] -printErr = hPutStrLn stderr +printOut = lift . hPutStrLn stdout +printErr = lift . hPutStrLn stderr - -instance JSON (JsonComment) where - showJSON (JsonComment filename c) = makeObj [ - ("file", showJSON filename), - ("line", showJSON $ scLine c), - ("column", showJSON $ scColumn c), - ("level", showJSON $ scSeverity c), - ("code", showJSON $ scCode c), - ("message", showJSON $ scMessage c) +instance JSON (PositionedComment) where + showJSON comment@(PositionedComment pos (Comment level code string)) = makeObj [ + ("file", showJSON $ posFile pos), + ("line", showJSON $ posLine pos), + ("column", showJSON $ posColumn pos), + ("level", showJSON $ severityText comment), + ("code", showJSON code), + ("message", showJSON string) ] + where + readJSON = undefined -parseArguments :: [String] -> ErrorT Status IO ([Flag], [FilePath]) + +parseArguments :: [String] -> ExceptT Status IO ([Flag], [FilePath]) parseArguments argv = case getOpt Permute options argv of (opts, files, []) -> return (opts, files) (_, _, errors) -> do - liftIO . printErr $ concat errors ++ "\n" ++ usageInfo header options + printErr $ concat errors ++ "\n" ++ usageInfo header options throwError SyntaxFailure -formats :: Map.Map String (AnalysisOptions -> [FilePath] -> IO Status) formats = Map.fromList [ +{- ("json", forJson), ("gcc", forGcc), ("checkstyle", forCheckstyle), +-} ("tty", forTty) ] -toStatus = liftM (either id (const NoProblems)) . runErrorT - -catchExceptions :: IO Status -> IO Status -catchExceptions action = action `catch` handler - where - handler err = do - printErr $ show (err :: SomeException) - return RuntimeException - -checkComments comments = if null comments then NoProblems else SomeProblems - -forTty :: AnalysisOptions -> [FilePath] -> IO Status -forTty options files = do - output <- mapM doFile files - return $ mconcat output +forTty :: SystemInterface IO -> CheckSpec -> [FilePath] -> ExceptT Status IO () +forTty sys spec files = mapM_ doFile files where clear = ansi 0 ansi n = "\x1B[" ++ show n ++ "m" @@ -126,88 +133,99 @@ forTty options files = do colorComment level comment = ansi (colorForLevel level) ++ comment ++ clear - doFile path = catchExceptions $ do - contents <- readContents path - doInput path contents - - doInput filename contents = do + doFile filename = do + contents <- lift $ inputFile filename + comments <- lift (crComments <$> checkScript sys spec { csScript = contents }) let fileLines = lines contents - let lineCount = length fileLines - let comments = getComments options contents - let groups = groupWith scLine comments + let lineCount = fromIntegral $ length fileLines + let groups = groupWith lineNo comments colorFunc <- getColorFunc mapM_ (\x -> do - let lineNum = scLine (head x) + let lineNum = lineNo (head x) let line = if lineNum < 1 || lineNum > lineCount then "" - else fileLines !! (lineNum - 1) - putStrLn "" - putStrLn $ colorFunc "message" + else fileLines !! (fromIntegral $ lineNum - 1) + printOut "" + printOut $ colorFunc "message" ("In " ++ filename ++" line " ++ show lineNum ++ ":") - putStrLn (colorFunc "source" line) - mapM_ (\c -> putStrLn (colorFunc (scSeverity c) $ cuteIndent c)) x - putStrLn "" + printOut (colorFunc "source" line) + mapM_ (\c -> printOut (colorFunc (severityText c) $ cuteIndent c)) x + printOut "" ) groups - return . checkComments $ comments + cuteIndent :: PositionedComment -> String cuteIndent comment = - replicate (scColumn comment - 1) ' ' ++ - "^-- " ++ code (scCode comment) ++ ": " ++ scMessage comment + replicate (fromIntegral $ colNo comment - 1) ' ' ++ + "^-- " ++ code (codeNo comment) ++ ": " ++ messageText comment code code = "SC" ++ show code getColorFunc = do - term <- hIsTerminalDevice stdout + term <- lift $ hIsTerminalDevice stdout let windows = "mingw" `isPrefixOf` os return $ if term && not windows then colorComment else const id -forJson :: AnalysisOptions -> [FilePath] -> IO Status -forJson options files = catchExceptions $ do - comments <- runListT $ do - file <- ListT $ return files - comment <- ListT $ commentsFor options file - return $ JsonComment file comment - putStrLn $ encodeStrict comments - return $ checkComments comments +{- +forJson :: a -> Formatter +forJson _ result = do + let comments = concatMap getComments (crComments result) + lift $ putStrLn $ encodeStrict comments + where + getComments (_, FileResult comments) = comments + getComments (file, FileError str) = [ + PositionedComment + Position { + posFile = file, + posLine = 1, + posColumn = 1 + } + (Comment ErrorC 1000 str) + ] -- Mimic GCC "file:line:col: (error|warning|note): message" format -forGcc :: AnalysisOptions -> [FilePath] -> IO Status -forGcc options files = do - files <- mapM process files - return $ mconcat files +forGcc :: SystemInterface IO -> Formatter +forGcc io result = do + mapM_ (uncurry process) (crComments result) where - process file = catchExceptions $ do - contents <- readContents file - let comments = makeNonVirtual (getComments options contents) contents - mapM_ (putStrLn . format file) comments - return $ checkComments comments + process filename (FileError string) = do + printErr $ string + + process filename (FileResult result) = do + fileInput <- lift $ siReadFile io filename + when (isLeft fileInput) $ do + printErr $ "Failed to re-open " ++ filename + throwError RuntimeException + let contents = fromRight fileInput + let comments = makeNonVirtual result contents + mapM_ (printOut . format filename) comments format filename c = concat [ filename, ":", - show $ scLine c, ":", - show $ scColumn c, ": ", - case scSeverity c of + show $ lineNo c, ":", + show $ colNo c, ": ", + case severityText c of "error" -> "error" "warning" -> "warning" _ -> "note", ": ", - concat . lines $ scMessage c, - " [SC", show $ scCode c, "]" + concat . lines $ messageText c, + " [SC", show $ codeNo c, "]" ] -- Checkstyle compatible output. A bit of a hack to avoid XML dependencies -forCheckstyle :: AnalysisOptions -> [FilePath] -> IO Status -forCheckstyle options files = do - putStrLn "" - putStrLn "" - statuses <- mapM process files - putStrLn "" +forCheckstyle :: SystemInterface IO -> Formatter +forCheckstyle _ result = do + printOut "" + printOut "" + statuses <- mapM process (crComments result) + printOut "" return $ mconcat statuses where - process file = catchExceptions $ do - comments <- commentsFor options file - putStrLn (formatFile file comments) - return $ checkComments comments + process (file, FileError str) = + printOut (formatError file str) + + process (file, FileResult comments) = + printOut (formatFile file comments) severity "error" = "error" severity "warning" = "warning" @@ -225,35 +243,39 @@ forCheckstyle options files = do format c = concat [ "\n" ] -commentsFor options file = liftM (getComments options) $ readContents file + formatError file msg = concat [ + "\n", + "\n", + "" + ] +-} -getComments = shellCheck - -readContents :: FilePath -> IO String -readContents file = - if file == "-" - then getContents - else readFile file -- Realign comments from a tabstop of 8 to 1 makeNonVirtual comments contents = map fix comments where ls = lines contents - fix c = c { - scColumn = - if scLine c > 0 && scLine c <= length ls - then real (ls !! (scLine c - 1)) 0 0 (scColumn c) - else scColumn c - } + fix c@(PositionedComment pos comment) = PositionedComment pos { + posColumn = + if lineNo c > 0 && lineNo c <= fromIntegral (length ls) + then real (ls !! (fromIntegral $ lineNo c - 1)) 0 0 (colNo c) + else colNo c + } comment real _ r v target | target <= v = r real [] r v _ = r -- should never happen real ('\t':rest) r v target = @@ -285,7 +307,9 @@ getExclusions options = excludeCodes codes = filter (not . hasCode) where - hasCode c = scCode c `elem` codes + hasCode c = codeNo c `elem` codes + +toStatus = liftM (either id (const NoProblems)) . runExceptT main = do args <- getArgs @@ -303,32 +327,34 @@ statusToCode status = SupportFailure -> ExitFailure 4 RuntimeException -> ExitFailure 2 -process :: [Flag] -> [FilePath] -> ErrorT Status IO () +process :: [Flag] -> [FilePath] -> ExceptT Status IO () process flags files = do - options <- foldM (flip parseOption) defaultAnalysisOptions flags + options <- foldM (flip parseOption) emptyCheckSpec flags verifyFiles files let format = fromMaybe "tty" $ getOption flags "format" - case Map.lookup format formats of - Nothing -> do - liftIO $ do + formatter <- + case Map.lookup format formats of + Nothing -> do printErr $ "Unknown format " ++ format printErr "Supported formats:" mapM_ (printErr . write) $ Map.keys formats - throwError SupportFailure - where write s = " " ++ s - Just f -> ErrorT $ liftM Left $ f options files + throwError SupportFailure + where write s = " " ++ s + Just f -> ExceptT $ fmap Right $ return f + let sys = ioInterface (const False) + formatter sys options files parseOption flag options = case flag of Flag "shell" str -> - fromMaybe (die $ "Unknown shell: " ++ str) $ do - shell <- shellForExecutable str - return $ return options { optionShellType = Just shell } + fromMaybe (die $ "Unknown shell: " ++ str) $ do + shell <- shellForExecutable str + return $ return options { csShellTypeOverride = Just shell } Flag "exclude" str -> do new <- mapM parseNum $ split ',' str - let old = optionExcludes options - return options { optionExcludes = new ++ old } + let old = csExcludedWarnings options + return options { csExcludedWarnings = new ++ old } Flag "version" _ -> do liftIO printVersion @@ -337,19 +363,39 @@ parseOption flag options = _ -> return options where die s = do - liftIO $ printErr s + printErr s throwError SupportFailure parseNum ('S':'C':str) = parseNum str parseNum num = do unless (all isDigit num) $ do - liftIO . printErr $ "Bad exclusion: " ++ num + printErr $ "Bad exclusion: " ++ num throwError SyntaxFailure return (Prelude.read num :: Integer) +ioInterface filter = do + SystemInterface { + siReadFile = get + } + where + get file = do + if filter file + then (Right <$> inputFile file) `catch` handler + else return $ Left (file ++ " was not specified as input.") + + handler :: IOException -> IO (Either ErrorMessage String) + handler ex = return . Left $ show ex + +inputFile file = do + contents <- + if file == "-" + then getContents + else readFile file + return contents + verifyFiles files = when (null files) $ do - liftIO $ printErr "No files specified.\n" - liftIO $ printErr $ usageInfo header options + printErr "No files specified.\n" + printErr $ usageInfo header options throwError SyntaxFailure printVersion = do diff --git a/test/shellcheck.hs b/test/shellcheck.hs index bb58fbc..6ac02af 100644 --- a/test/shellcheck.hs +++ b/test/shellcheck.hs @@ -2,15 +2,17 @@ module Main where import Control.Monad import System.Exit -import qualified ShellCheck.Simple +import qualified ShellCheck.Checker import qualified ShellCheck.Analytics import qualified ShellCheck.Parser main = do putStrLn "Running ShellCheck tests..." - results <- sequence [ShellCheck.Simple.runTests, - ShellCheck.Analytics.runTests, - ShellCheck.Parser.runTests] - if and results then exitSuccess - else exitFailure - + results <- sequence [ + ShellCheck.Checker.runTests, + ShellCheck.Analytics.runTests, + ShellCheck.Parser.runTests + ] + if and results + then exitSuccess + else exitFailure