Handle annotations to the same line correctly

src/Annotator.hs

@@ -14,13 +14,13 @@ import System.Posix.Files
 import Control.Monad
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Reader
+import Control.Exception (evaluate)
 import Data.Function (on)
-import Data.List (delete, intercalate, foldl', nub)
-import Data.Foldable (foldlM)
+import Data.List (delete, intercalate, foldl')
 import Data.Char (isSpace)
 import Data.Ord
 import Data.Monoid
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, catMaybes)
 import qualified Data.Version as Vsn
 import qualified Data.List.NonEmpty as NE
 import Data.List.NonEmpty (NonEmpty(..))
@@ -76,10 +76,10 @@ options =
     "replace source-file after inserting annotations"
   , Option ['V'] ["version"]
     (NoArg (\opts -> opts { showVersion = Just FullVersion }))
-    "show version"
+    "show full version information"
   , Option [] ["short-version"]
     (NoArg (\opts -> opts { showVersion = Just ShortVersion }))
-    "show version"
+    "show just the version number"
   , Option ['h'] ["help"]
     (NoArg (\opts -> opts { showHelp = True }))
     "show usage information"
@@ -89,9 +89,9 @@ options =
   , Option ['C'] ["context"]
     (OptArg ((\f opts -> opts { contextLines = fromMaybe 0 $ readMaybe f }) . fromMaybe "0") "NUM")
     "specify how much context should be shown around a violation"
-  , Option ['A'] ["annotations"]
-    (ReqArg (\f opts -> opts { annotationFiles = (nub $ annotationFiles opts ++ [f]) }) "FILE")
-    "load automatic annotation rules"
+  -- , Option ['A'] ["annotations"]
+  --   (ReqArg (\f opts -> opts { annotationFiles = (nub $ annotationFiles opts ++ [f]) }) "FILE")
+  --   "load automatic annotation rules"
   ]
 
 readMaybe :: (Read a) => String -> Maybe a
@@ -121,7 +121,7 @@ defaultMain = do
 
   case showVersion opts of
     Just FullVersion -> do
-      putStrLn $ unlines
+      putStr $ unlines
         [
           "Annotator v" <> (Vsn.showVersion version)
         , "Copyright (c) 2022 Alexander Kobjolke <alexander.kobjolke@atlas-elektronik.com>"
@@ -133,7 +133,7 @@ defaultMain = do
     Nothing -> pure ()
 
   when (showHelp opts) $ do
-    putStrLn $ usageInfo header options
+    putStr $ usageInfo header options
     exitWith ExitSuccess
 
   runReaderT (genericMain fn) opts
@@ -194,6 +194,7 @@ genericMain file = do
   verbose Chatty $ show opts
   liftIO $ hSetBuffering stdin NoBuffering
   violations' <- liftIO $ filter (isRelevant (onlyNewest opts)) . parseViolations <$> readFile file
+  _ <- liftIO $ evaluate (length violations') -- ensure file is completely read
 
   let mviolations = NE.nonEmpty violations'
 
@@ -234,16 +235,25 @@ handleViolations violations = do
   if fileExists
     then do
       liftIO $ hPutStrLn stderr header
-      contents' <- liftIO $ readFile fname
-      let !contents = id contents'
+      contents <- liftIO $ readFile fname
+      _ <- liftIO $ evaluate (length contents) -- ensure file is completely read
 
-      newContent <- foldlM handleViolation contents violations
+      let numberedContent = zip [1..] . lines $ contents
+
+      annotations <- (catMaybes . NE.toList) <$> mapM (handleViolation contents) violations
+
+      let annotatedLines = fmap annotationToLine annotations
+          newContent = unlines . map snd $ mergeLines annotatedLines numberedContent
 
       liftIO $ writeFile fname' newContent
 
       liftIO $ when (inplace opts) $ rename fname' fname
     else do
       verbose Low $ "skipping non-existent file " <> fname
+  where
+    annotationToLine :: AnnotatedViolation -> (Int, String)
+    annotationToLine (AnnotatedViolation Violation{..} a indent) =
+      (line, indent ++ showAnnotation a description)
 
 
 data UserChoice = Abort
@@ -309,24 +319,27 @@ mergeLines [] r = r
 mergeLines l [] = l
 mergeLines !lhs@(left@(nl,_):ls) !rhs@(right@(nr,_):rs)
   | nl <= nr = left : mergeLines ls rhs
-  | nl > nr = right : mergeLines lhs rs
+  | otherwise = right : mergeLines lhs rs
+
+data AnnotatedViolation = AnnotatedViolation Violation Annotation String
+  deriving (Eq, Show)
 
 -- | handle a single violation
 --
 -- The function gets the current content of the file and should result in the
 -- new content of the file
-handleViolation :: Content -> Violation -> App Content
+handleViolation :: Content -> Violation -> App (Maybe AnnotatedViolation)
 handleViolation content v@Violation{..} = do
   verbose Low $ show v
   opts <- ask
 
   let (before, after) = splitAt (line-1) . zip [1..] . lines $ content
       context = getContext (contextLines opts) before after
-      !indent = takeWhile isSpace (snd . head $ after)
+      indent = takeWhile isSpace (snd . head $ after)
 
   -- print some context
   liftIO $ forM_ context (\(n, code) -> do
-                    let marker = '>' <$ indent
+                    let marker = ">>>>"
                     when (n == line) $ putStrLn (intercalate " " [ marker
                                                                  , show age
                                                                  , "violation of rule"
@@ -341,11 +354,8 @@ handleViolation content v@Violation{..} = do
   choice <- getUserChoice v
   case choice of
     Abort -> liftIO $ exitSuccess
-    Annotate annotation -> do
-      let !comment = showAnnotation annotation description
-          !newContent = unlines . map snd $ (before ++ ((0, indent ++ comment) : after))
-      pure newContent
-    Skip -> pure content
+    Annotate annotation -> pure $ Just (AnnotatedViolation v annotation indent)
+    Skip -> pure Nothing
     Help -> handleViolation content v
 
 -- | Get some context around some line