diff --git a/shellcheck.hs b/shellcheck.hs index 668a71a..399e44d 100644 --- a/shellcheck.hs +++ b/shellcheck.hs @@ -74,7 +74,7 @@ data Options = Options { defaultOptions = Options { checkSpec = emptyCheckSpec, externalSources = False, - formatterOptions = FormatterOptions { + formatterOptions = newFormatterOptions { foColorOption = ColorAuto }, minSeverity = StyleC diff --git a/src/ShellCheck/Analyzer.hs b/src/ShellCheck/Analyzer.hs index 235afe3..ffbc4e5 100644 --- a/src/ShellCheck/Analyzer.hs +++ b/src/ShellCheck/Analyzer.hs @@ -30,7 +30,7 @@ import qualified ShellCheck.Checks.ShellSupport -- TODO: Clean up the cruft this is layered on analyzeScript :: AnalysisSpec -> AnalysisResult -analyzeScript spec = AnalysisResult { +analyzeScript spec = newAnalysisResult { arComments = filterByAnnotation spec params . nub $ runAnalytics spec diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index b47651f..e12588b 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -109,12 +109,11 @@ data DataSource = data VariableState = Dead Token String | Alive deriving (Show) -defaultSpec root = AnalysisSpec { - asScript = root, +defaultSpec root = spec { asShellType = Nothing, asCheckSourced = False, asExecutionMode = Executed -} +} where spec = newAnalysisSpec root pScript s = let @@ -134,7 +133,14 @@ producesComments c s = do makeComment :: Severity -> Id -> Code -> String -> TokenComment makeComment severity id code note = - TokenComment id $ Comment severity code note + newTokenComment { + tcId = id, + tcComment = newComment { + cSeverity = severity, + cCode = code, + cMessage = note + } + } addComment note = tell [note] @@ -811,10 +817,9 @@ filterByAnnotation asSpec params = filter (not . shouldIgnore) where token = asScript asSpec - idFor (TokenComment id _) = id shouldIgnore note = any (shouldIgnoreFor (getCode note)) $ - getPath parents (T_Bang $ idFor note) + getPath parents (T_Bang $ tcId note) shouldIgnoreFor num (T_Annotation _ anns _) = any hasNum anns where @@ -823,7 +828,7 @@ filterByAnnotation asSpec params = shouldIgnoreFor _ T_Include {} = not $ asCheckSourced asSpec shouldIgnoreFor _ _ = False parents = parentMap params - getCode (TokenComment _ (Comment _ c _)) = c + getCode = cCode . tcComment -- Is this a ${#anything}, to get string length or array count? isCountingReference (T_DollarBraced id token) = diff --git a/src/ShellCheck/Checker.hs b/src/ShellCheck/Checker.hs index dc17364..ac58876 100644 --- a/src/ShellCheck/Checker.hs +++ b/src/ShellCheck/Checker.hs @@ -37,16 +37,20 @@ import Control.Monad import Test.QuickCheck.All -tokenToPosition startMap (TokenComment id c) = fromMaybe fail $ do - span <- Map.lookup id startMap - return $ PositionedComment (fst span) (snd span) c +tokenToPosition startMap t = fromMaybe fail $ do + span <- Map.lookup (tcId t) startMap + return $ newPositionedComment { + pcStartPos = fst span, + pcEndPos = snd span, + pcComment = tcComment t + } 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 { + return emptyCheckResult { crFilename = csFilename spec, crComments = results } @@ -67,28 +71,38 @@ checkScript sys spec = do return . nub . sortMessages . filter shouldInclude $ (parseMessages ++ map translator analysisMessages) - shouldInclude (PositionedComment _ _ (Comment severity code _)) = - severity <= csMinSeverity spec && - code `notElem` csExcludedWarnings spec + shouldInclude pc = + let code = cCode (pcComment pc) + severity = cSeverity (pcComment pc) + in + code `notElem` csExcludedWarnings spec && + severity <= csMinSeverity spec sortMessages = sortBy (comparing order) - order (PositionedComment pos _ (Comment severity code message)) = - (posFile pos, posLine pos, posColumn pos, severity, code, message) - getPosition (PositionedComment pos _ _) = pos + order pc = + let pos = pcStartPos pc + comment = pcComment pc in + (posFile pos, + posLine pos, + posColumn pos, + cSeverity comment, + cCode comment, + cMessage comment) + getPosition = pcStartPos analysisSpec root = - AnalysisSpec { + as { asScript = root, asShellType = csShellTypeOverride spec, asCheckSourced = csCheckSourced spec, asExecutionMode = Executed - } + } where as = newAnalysisSpec root getErrors sys spec = sort . map getCode . crComments $ runIdentity (checkScript sys spec) where - getCode (PositionedComment _ _ (Comment _ code _)) = code + getCode = cCode . pcComment check = checkWithIncludes [] diff --git a/src/ShellCheck/Formatter/Format.hs b/src/ShellCheck/Formatter/Format.hs index adce0b6..5e46713 100644 --- a/src/ShellCheck/Formatter/Format.hs +++ b/src/ShellCheck/Formatter/Format.hs @@ -30,17 +30,17 @@ data Formatter = Formatter { footer :: IO () } -sourceFile (PositionedComment pos _ _) = posFile pos -lineNo (PositionedComment pos _ _) = posLine pos -endLineNo (PositionedComment _ end _) = posLine end -colNo (PositionedComment pos _ _) = posColumn pos -endColNo (PositionedComment _ end _) = posColumn end -codeNo (PositionedComment _ _ (Comment _ code _)) = code -messageText (PositionedComment _ _ (Comment _ _ t)) = t +sourceFile = posFile . pcStartPos +lineNo = posLine . pcStartPos +endLineNo = posLine . pcEndPos +colNo = posColumn . pcStartPos +endColNo = posColumn . pcEndPos +codeNo = cCode . pcComment +messageText = cMessage . pcComment severityText :: PositionedComment -> String -severityText (PositionedComment _ _ (Comment c _ _)) = - case c of +severityText pc = + case cSeverity (pcComment pc) of ErrorC -> "error" WarningC -> "warning" InfoC -> "info" @@ -51,11 +51,14 @@ makeNonVirtual comments contents = map fix comments where ls = lines contents - fix c@(PositionedComment start end comment) = PositionedComment start { - posColumn = realignColumn lineNo colNo c - } end { - posColumn = realignColumn endLineNo endColNo c - } comment + fix c = c { + pcStartPos = (pcStartPos c) { + posColumn = realignColumn lineNo colNo c + } + , pcEndPos = (pcEndPos c) { + posColumn = realignColumn endLineNo endColNo c + } + } realignColumn lineNo colNo c = if lineNo c > 0 && lineNo c <= fromIntegral (length ls) then real (ls !! fromIntegral (lineNo c - 1)) 0 0 (colNo c) diff --git a/src/ShellCheck/Formatter/JSON.hs b/src/ShellCheck/Formatter/JSON.hs index 490a06b..aac4d20 100644 --- a/src/ShellCheck/Formatter/JSON.hs +++ b/src/ShellCheck/Formatter/JSON.hs @@ -40,7 +40,10 @@ format = do } instance ToJSON (PositionedComment) where - toJSON comment@(PositionedComment start end (Comment level code string)) = + toJSON comment = + let start = pcStartPos comment + end = pcEndPos comment + c = pcComment comment in object [ "file" .= posFile start, "line" .= posLine start, @@ -48,11 +51,14 @@ instance ToJSON (PositionedComment) where "column" .= posColumn start, "endColumn" .= posColumn end, "level" .= severityText comment, - "code" .= code, - "message" .= string + "code" .= cCode c, + "message" .= cMessage c ] - toEncoding comment@(PositionedComment start end (Comment level code string)) = + toEncoding comment = + let start = pcStartPos comment + end = pcEndPos comment + c = pcComment comment in pairs ( "file" .= posFile start <> "line" .= posLine start @@ -60,8 +66,8 @@ instance ToJSON (PositionedComment) where <> "column" .= posColumn start <> "endColumn" .= posColumn end <> "level" .= severityText comment - <> "code" .= code - <> "message" .= string + <> "code" .= cCode c + <> "message" .= cMessage c ) outputError file msg = hPutStrLn stderr $ file ++ ": " ++ msg diff --git a/src/ShellCheck/Interface.hs b/src/ShellCheck/Interface.hs index a0b93f2..8432f0e 100644 --- a/src/ShellCheck/Interface.hs +++ b/src/ShellCheck/Interface.hs @@ -17,7 +17,39 @@ You should have received a copy of the GNU General Public License along with this program. If not, see . -} -module ShellCheck.Interface where +module ShellCheck.Interface + ( + SystemInterface(..) + , CheckSpec(csFilename, csScript, csCheckSourced, csExcludedWarnings, csShellTypeOverride, csMinSeverity) + , CheckResult(crFilename, crComments) + , ParseSpec(psFilename, psScript, psCheckSourced, psShellTypeOverride) + , ParseResult(prComments, prTokenPositions, prRoot) + , AnalysisSpec(asScript, asShellType, asExecutionMode, asCheckSourced) + , AnalysisResult(arComments) + , FormatterOptions(foColorOption) + , Shell(Ksh, Sh, Bash, Dash) + , ExecutionMode(Executed, Sourced) + , ErrorMessage + , Code + , Severity(ErrorC, WarningC, InfoC, StyleC) + , Position(posFile, posLine, posColumn) + , Comment(cSeverity, cCode, cMessage) + , PositionedComment(pcStartPos , pcEndPos , pcComment) + , ColorOption(ColorAuto, ColorAlways, ColorNever) + , TokenComment(tcId, tcComment) + , emptyCheckResult + , newParseResult + , newAnalysisSpec + , newAnalysisResult + , newFormatterOptions + , newPosition + , newTokenComment + , mockedSystemInterface + , newParseSpec + , emptyCheckSpec + , newPositionedComment + , newComment + ) where import ShellCheck.AST import Control.Monad.Identity @@ -44,6 +76,12 @@ data CheckResult = CheckResult { crComments :: [PositionedComment] } deriving (Show, Eq) +emptyCheckResult :: CheckResult +emptyCheckResult = CheckResult { + crFilename = "", + crComments = [] +} + emptyCheckSpec :: CheckSpec emptyCheckSpec = CheckSpec { csFilename = "", @@ -76,6 +114,13 @@ data ParseResult = ParseResult { prRoot :: Maybe Token } deriving (Show, Eq) +newParseResult :: ParseResult +newParseResult = ParseResult { + prComments = [], + prTokenPositions = Map.empty, + prRoot = Nothing +} + -- Analyzer input and output data AnalysisSpec = AnalysisSpec { asScript :: Token, @@ -84,16 +129,30 @@ data AnalysisSpec = AnalysisSpec { asCheckSourced :: Bool } +newAnalysisSpec token = AnalysisSpec { + asScript = token, + asShellType = Nothing, + asExecutionMode = Executed, + asCheckSourced = False +} + newtype AnalysisResult = AnalysisResult { arComments :: [TokenComment] } +newAnalysisResult = AnalysisResult { + arComments = [] +} -- Formatter options newtype FormatterOptions = FormatterOptions { foColorOption :: ColorOption } +newFormatterOptions = FormatterOptions { + foColorOption = ColorAuto +} + -- Supporting data types data Shell = Ksh | Sh | Bash | Dash deriving (Show, Eq) @@ -109,9 +168,48 @@ data Position = Position { 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 Position Comment deriving (Show, Eq) -data TokenComment = TokenComment Id Comment deriving (Show, Eq) +newPosition :: Position +newPosition = Position { + posFile = "", + posLine = 1, + posColumn = 1 +} + +data Comment = Comment { + cSeverity :: Severity, + cCode :: Code, + cMessage :: String +} deriving (Show, Eq) + +newComment :: Comment +newComment = Comment { + cSeverity = StyleC, + cCode = 0, + cMessage = "" +} + +data PositionedComment = PositionedComment { + pcStartPos :: Position, + pcEndPos :: Position, + pcComment :: Comment +} deriving (Show, Eq) + +newPositionedComment :: PositionedComment +newPositionedComment = PositionedComment { + pcStartPos = newPosition, + pcEndPos = newPosition, + pcComment = newComment +} + +data TokenComment = TokenComment { + tcId :: Id, + tcComment :: Comment +} deriving (Show, Eq) + +newTokenComment = TokenComment { + tcId = Id 0, + tcComment = newComment +} data ColorOption = ColorAuto diff --git a/src/ShellCheck/Parser.hs b/src/ShellCheck/Parser.hs index 4fcfbb4..667eaca 100644 --- a/src/ShellCheck/Parser.hs +++ b/src/ShellCheck/Parser.hs @@ -3051,11 +3051,11 @@ debugParseScript string = result { -- Remove the noisiest parts prTokenPositions = Map.fromList [ - (Id 0, (Position { + (Id 0, (newPosition { posFile = "removed for clarity", posLine = -1, posColumn = -1 - }, Position { + }, newPosition { posFile = "removed for clarity", posLine = -1, posColumn = -1 @@ -3144,14 +3144,14 @@ parseShell env name contents = do (result, state) <- runParser env (parseWithNotes readScript) name contents case result of Right (script, userstate) -> - return ParseResult { + return newParseResult { prComments = map toPositionedComment $ nub $ parseNotes userstate ++ parseProblems state, prTokenPositions = Map.map startEndPosToPos (positionMap userstate), prRoot = Just $ reattachHereDocs script (hereDocMap userstate) } Left err -> - return ParseResult { + return newParseResult { prComments = map toPositionedComment $ notesForContext (contextStack state) @@ -3218,10 +3218,18 @@ reattachHereDocs root map = toPositionedComment :: ParseNote -> PositionedComment toPositionedComment (ParseNote start end severity code message) = - PositionedComment (posToPos start) (posToPos end) $ Comment severity code message + newPositionedComment { + pcStartPos = (posToPos start) + , pcEndPos = (posToPos end) + , pcComment = newComment { + cSeverity = severity + , cCode = code + , cMessage = message + } + } posToPos :: SourcePos -> Position -posToPos sp = Position { +posToPos sp = newPosition { posFile = sourceName sp, posLine = fromIntegral $ sourceLine sp, posColumn = fromIntegral $ sourceColumn sp