From 856d57f7d87fe71bdca4116818610889e55f09c4 Mon Sep 17 00:00:00 2001 From: Russell Harmon Date: Sat, 18 Jun 2016 14:50:18 -0700 Subject: [PATCH 1/2] PositionedComment and ParseNote contains end cols. This change makes PositionedComment and ParseNote contain end columns. It additionally modifies the JSON formatter to show the end column in an "endColumn" property. No modifications to the messages shown by any other formatter have been made. Currently, all checks set the end column to the start column. It should now be possible however to start setting the end column in the parser. Additional work is needed to set the end column during AST analysis. --- ShellCheck/Checker.hs | 10 +++++----- ShellCheck/Formatter/Format.hs | 25 +++++++++++++++---------- ShellCheck/Formatter/JSON.hs | 9 +++++---- ShellCheck/Interface.hs | 2 +- ShellCheck/Parser.hs | 30 ++++++++++++++++++------------ 5 files changed, 44 insertions(+), 32 deletions(-) diff --git a/ShellCheck/Checker.hs b/ShellCheck/Checker.hs index 2bfdc94..ce63a75 100644 --- a/ShellCheck/Checker.hs +++ b/ShellCheck/Checker.hs @@ -39,7 +39,7 @@ import Test.QuickCheck.All tokenToPosition map (TokenComment id c) = fromMaybe fail $ do position <- Map.lookup id map - return $ PositionedComment position c + return $ PositionedComment position position c where fail = error "Internal shellcheck error: id doesn't exist. Please report!" @@ -65,13 +65,13 @@ checkScript sys spec = do return . nub . sortMessages . filter shouldInclude $ (parseMessages ++ map translator analysisMessages) - shouldInclude (PositionedComment _ (Comment _ code _)) = + shouldInclude (PositionedComment _ _ (Comment _ code _)) = code `notElem` csExcludedWarnings spec sortMessages = sortBy (comparing order) - order (PositionedComment pos (Comment severity code message)) = + order (PositionedComment pos _ (Comment severity code message)) = (posFile pos, posLine pos, posColumn pos, severity, code, message) - getPosition (PositionedComment pos _) = pos + getPosition (PositionedComment pos _ _) = pos analysisSpec root = AnalysisSpec { @@ -84,7 +84,7 @@ getErrors sys spec = sort . map getCode . crComments $ runIdentity (checkScript sys spec) where - getCode (PositionedComment _ (Comment _ code _)) = code + getCode (PositionedComment _ _ (Comment _ code _)) = code check = checkWithIncludes [] diff --git a/ShellCheck/Formatter/Format.hs b/ShellCheck/Formatter/Format.hs index d9bfaa9..143de8d 100644 --- a/ShellCheck/Formatter/Format.hs +++ b/ShellCheck/Formatter/Format.hs @@ -30,13 +30,15 @@ data Formatter = Formatter { footer :: IO () } -lineNo (PositionedComment pos _) = posLine pos -colNo (PositionedComment pos _) = posColumn pos -codeNo (PositionedComment _ (Comment _ code _)) = code -messageText (PositionedComment _ (Comment _ _ t)) = t +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 severityText :: PositionedComment -> String -severityText (PositionedComment _ (Comment c _ _)) = +severityText (PositionedComment _ _ (Comment c _ _)) = case c of ErrorC -> "error" WarningC -> "warning" @@ -48,12 +50,15 @@ makeNonVirtual comments contents = map fix comments where ls = lines contents - 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 + fix c@(PositionedComment start end comment) = PositionedComment start { + posColumn = realignColumn lineNo colNo c + } end { + posColumn = realignColumn endLineNo endColNo c } comment + realignColumn lineNo colNo c = + if lineNo c > 0 && lineNo c <= fromIntegral (length ls) + then real (ls !! fromIntegral (lineNo c - 1)) 0 0 (colNo c) + else colNo c real _ r v target | target <= v = r real [] r v _ = r -- should never happen real ('\t':rest) r v target = diff --git a/ShellCheck/Formatter/JSON.hs b/ShellCheck/Formatter/JSON.hs index 018db27..cd1a054 100644 --- a/ShellCheck/Formatter/JSON.hs +++ b/ShellCheck/Formatter/JSON.hs @@ -37,10 +37,11 @@ format = do } 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), + showJSON comment@(PositionedComment start end (Comment level code string)) = makeObj [ + ("file", showJSON $ posFile start), + ("line", showJSON $ posLine start), + ("column", showJSON $ posColumn start), + ("endColumn", showJSON $ posColumn end), ("level", showJSON $ severityText comment), ("code", showJSON code), ("message", showJSON string) diff --git a/ShellCheck/Interface.hs b/ShellCheck/Interface.hs index 41517ff..6662a1e 100644 --- a/ShellCheck/Interface.hs +++ b/ShellCheck/Interface.hs @@ -94,7 +94,7 @@ data Position = Position { } deriving (Show, Eq) data Comment = Comment Severity Code String deriving (Show, Eq) -data PositionedComment = PositionedComment Position Comment deriving (Show, Eq) +data PositionedComment = PositionedComment Position Position Comment deriving (Show, Eq) data TokenComment = TokenComment Id Comment deriving (Show, Eq) data ColorOption = diff --git a/ShellCheck/Parser.hs b/ShellCheck/Parser.hs index eaf81a8..6d875ee 100644 --- a/ShellCheck/Parser.hs +++ b/ShellCheck/Parser.hs @@ -135,7 +135,7 @@ 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 ParseNote = ParseNote SourcePos SourcePos Severity Code String deriving (Show, Eq) data Context = ContextName SourcePos String | ContextAnnotation [Annotation] @@ -162,9 +162,9 @@ initialUserState = UserState { pendingHereDocs = [] } -codeForParseNote (ParseNote _ _ code _) = code +codeForParseNote (ParseNote _ _ _ code _) = code noteToParseNote map (Note id severity code message) = - ParseNote pos severity code message + ParseNote pos pos severity code message where pos = fromJust $ Map.lookup id map @@ -320,14 +320,16 @@ pushContext c = do v <- getCurrentContexts setCurrentContexts (c:v) -parseProblemAt pos level code msg = do +parseProblemAtWithEnd start end level code msg = do irrelevant <- shouldIgnoreCode code unless irrelevant $ Ms.modify (\state -> state { parseProblems = note:parseProblems state }) where - note = ParseNote pos level code msg + note = ParseNote start end level code msg + +parseProblemAt pos = parseProblemAtWithEnd pos pos -- Store non-parse problems inside @@ -335,7 +337,9 @@ parseNote c l a = do pos <- getPosition parseNoteAt pos c l a -parseNoteAt pos c l a = addParseNote $ ParseNote pos c l a +parseNoteAt pos c l a = addParseNote $ ParseNote pos pos c l a + +parseNoteAtWithEnd start end c l a = addParseNote $ ParseNote start end c l a --------- Convenient combinators thenSkip main follow = do @@ -2571,13 +2575,15 @@ parseWithNotes parser = do state <- getState return (item, state) -compareNotes (ParseNote pos1 level1 _ s1) (ParseNote pos2 level2 _ s2) = compare (pos1, level1) (pos2, level2) +compareNotes (ParseNote pos1 pos1' level1 _ s1) (ParseNote pos2 pos2' level2 _ s2) = compare (pos1, pos1', level1) (pos2, pos2', level2) sortNotes = sortBy compareNotes makeErrorFor parsecError = - ParseNote (errorPos parsecError) ErrorC 1072 $ + ParseNote pos pos ErrorC 1072 $ getStringFromParsec $ errorMessages parsecError + where + pos = errorPos parsecError getStringFromParsec errors = case map f errors of @@ -2630,9 +2636,9 @@ parseShell sys name contents = do isName (ContextName _ _) = True isName _ = False notesForContext list = zipWith ($) [first, second] $ filter isName list - first (ContextName pos str) = ParseNote pos ErrorC 1073 $ + first (ContextName pos str) = ParseNote pos pos ErrorC 1073 $ "Couldn't parse this " ++ str ++ "." - second (ContextName pos str) = ParseNote pos InfoC 1009 $ + second (ContextName pos str) = ParseNote pos pos InfoC 1009 $ "The mentioned parser error was in this " ++ str ++ "." reattachHereDocs root map = @@ -2644,8 +2650,8 @@ reattachHereDocs root map = f t = t toPositionedComment :: ParseNote -> PositionedComment -toPositionedComment (ParseNote pos severity code message) = - PositionedComment (posToPos pos) $ Comment severity code message +toPositionedComment (ParseNote start end severity code message) = + PositionedComment (posToPos start) (posToPos end) $ Comment severity code message posToPos :: SourcePos -> Position posToPos sp = Position { From 7f5f5b7fb5be87cb73970ba695d57e2517ab6b2f Mon Sep 17 00:00:00 2001 From: Russell Harmon Date: Sat, 18 Jun 2016 14:59:47 -0700 Subject: [PATCH 2/2] Make SC1035 emit a proper end column Example JSON output: ``` $ shellcheck -s bash -f json /dev/stdin <<< "[[0 -eq 1 ]]" [{"file":"/tmp/zshNCNwPz","line":1,"column":1,"endColumn":3,"level":"error","code":1035,"message":"You need a space after the [[ and before the ]]."}] ``` --- ShellCheck/Parser.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ShellCheck/Parser.hs b/ShellCheck/Parser.hs index 6d875ee..ad0cc35 100644 --- a/ShellCheck/Parser.hs +++ b/ShellCheck/Parser.hs @@ -814,7 +814,7 @@ readCondition = called "test expression" $ do pos <- getPosition space <- allspacing when (null space) $ - parseProblemAt pos ErrorC 1035 $ "You need a space after the " ++ + parseProblemAtWithEnd opos pos ErrorC 1035 $ "You need a space after the " ++ if single then "[ and before the ]." else "[[ and before the ]]."