Process violations in order

Since we now collect all violations before changing the original contents, we
can process the violations in order instead of from last to first (otherwise
locations within the file would change).
This commit is contained in:
Alexander Kobjolke 2022-03-04 22:07:03 +01:00
parent da7143c61e
commit 7d0f4da27f

View file

@ -16,7 +16,7 @@ import Control.Monad.IO.Class
import Control.Monad.Trans.Reader import Control.Monad.Trans.Reader
import Control.Exception (evaluate) import Control.Exception (evaluate)
import Data.Function (on) import Data.Function (on)
import Data.List (delete, intercalate, foldl') import Data.List (delete, intercalate, foldl', sortBy)
import Data.Char (isSpace) import Data.Char (isSpace)
import Data.Ord import Data.Ord
import Data.Monoid import Data.Monoid
@ -29,7 +29,7 @@ import Annotator.Rule
import Annotator.Annotation import Annotator.Annotation
version :: Vsn.Version version :: Vsn.Version
version = Vsn.makeVersion [0,0,2,0] version = Vsn.makeVersion [0,0,2,1]
type App a = ReaderT Options IO a type App a = ReaderT Options IO a
@ -200,7 +200,7 @@ genericMain file = do
case mviolations of case mviolations of
Just violations -> do Just violations -> do
let sortedViolations = NE.sortBy reverseOccurrences violations let sortedViolations = NE.sortBy compareLocation violations
groupedViolations = NE.groupBy ((==) `on` filename) sortedViolations groupedViolations = NE.groupBy ((==) `on` filename) sortedViolations
verbose Chatty $ "all violations: " <> show sortedViolations verbose Chatty $ "all violations: " <> show sortedViolations
forM_ groupedViolations handleViolations forM_ groupedViolations handleViolations
@ -209,8 +209,8 @@ genericMain file = do
liftIO $ hPutStrLn stderr "Defects file is empty" liftIO $ hPutStrLn stderr "Defects file is empty"
where where
reverseOccurrences :: Violation -> Violation -> Ordering compareLocation :: Violation -> Violation -> Ordering
reverseOccurrences = comparing filename <> flip (comparing line) compareLocation = comparing filename <> comparing line
isRelevant :: Bool -> Violation -> Bool isRelevant :: Bool -> Violation -> Bool
isRelevant newestOnly v isRelevant newestOnly v
@ -235,14 +235,17 @@ handleViolations violations = do
if fileExists if fileExists
then do then do
liftIO $ hPutStrLn stderr header liftIO $ hPutStrLn stderr header
contents <- liftIO $ readFile fname
_ <- liftIO $ evaluate (length contents) -- ensure file is completely read
let numberedContent = zip [1..] . lines $ contents verbose Chatty $ show violations
annotations <- (catMaybes . NE.toList) <$> mapM (handleViolation contents) violations content <- liftIO $ readFile fname
_ <- liftIO $ evaluate (length content) -- ensure file is completely read
let annotatedLines = fmap annotationToLine annotations let numberedContent = zip [1..] . lines $ content
annotations <- (catMaybes . NE.toList) <$> mapM (handleViolation content) violations
let annotatedLines = sortBy (comparing fst) $ fmap annotationToLine annotations
newContent = unlines . map snd $ mergeLines annotatedLines numberedContent newContent = unlines . map snd $ mergeLines annotatedLines numberedContent
liftIO $ writeFile fname' newContent liftIO $ writeFile fname' newContent
@ -337,6 +340,8 @@ handleViolation content v@Violation{..} = do
context = getContext (contextLines opts) before after context = getContext (contextLines opts) before after
indent = takeWhile isSpace (snd . head $ after) indent = takeWhile isSpace (snd . head $ after)
verbose Chatty $ "indentation: " <> show indent
-- print some context -- print some context
liftIO $ forM_ context (\(n, code) -> do liftIO $ forM_ context (\(n, code) -> do
let marker = ">>>>" let marker = ">>>>"