Implement loading of automatic annotation files

example/automatic-rules

@@ -0,0 +1 @@
+Intentional (Rule "autosar_cpp14_a18_9_1") "Test auto"

src/Annotator.hs

@@ -16,8 +16,9 @@ import Control.Monad.IO.Class
 import Control.Monad.Trans.Reader
 import Control.Exception (evaluate)
 import Data.Function (on)
-import Data.List (delete, intercalate, foldl', sortBy)
+import Data.List (delete, intercalate, foldl', sortBy, nub)
 import Data.Char (isSpace)
+import Data.Either (rights)
 import Data.Ord
 import Data.Monoid
 import Data.Maybe (fromMaybe, catMaybes)
@@ -29,7 +30,7 @@ import Annotator.Rule
 import Annotator.Annotation
 
 version :: Vsn.Version
-version = Vsn.makeVersion [0,0,2,1]
+version = Vsn.makeVersion [0,0,3,0]
 
 type App a = ReaderT Options IO a
 
@@ -52,6 +53,7 @@ data Options = Options
   , contextLines :: Int
   , onlyNewest :: Bool
   , annotationFiles :: [FilePath]
+  , autoAnnotations :: [Annotation]
   }
   deriving (Show, Eq)
 
@@ -64,6 +66,7 @@ defaultOptions = Options
   , contextLines = 0
   , onlyNewest = True
   , annotationFiles = []
+  , autoAnnotations = []
   }
 
 options :: [OptDescr (Options -> Options)]
@@ -89,9 +92,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
@@ -136,7 +139,11 @@ defaultMain = do
     putStr $ usageInfo header options
     exitWith ExitSuccess
 
-  runReaderT (genericMain fn) opts
+  automaticAnnotations <- rights . concat <$> mapM fromFile (annotationFiles opts)
+
+  let opts' = opts { autoAnnotations = automaticAnnotations }
+
+  runReaderT (genericMain fn) opts'
 
   where
     header = unlines $
@@ -340,28 +347,44 @@ handleViolation content v@Violation{..} = do
       context = getContext (contextLines opts) before after
       indent = takeWhile isSpace (snd . head $ after)
 
-  verbose Chatty $ "indentation: " <> show indent
+  case lookupAnnotation rule (autoAnnotations opts) of
+    Just a -> do
+      verbose Low $ "automatically annotated violation of rule " <> show rule
+      pure $ Just (AnnotatedViolation v a indent)
+    _ -> do
+      verbose Chatty $ "indentation: " <> show indent
 
-  -- print some context
-  liftIO $ forM_ context (\(n, code) -> do
-                    let marker = ">>>>"
-                    when (n == line) $ putStrLn (intercalate " " [ marker
-                                                                 , show age
-                                                                 , "violation of rule"
-                                                                 , show rule
-                                                                 , "in line"
-                                                                 , show line <> ":"
-                                                                 , description
-                                                                 ])
-                    putStrLn (code))
+      -- print some context
+      liftIO $ forM_ context (\(n, code) -> do
+                        let marker = ">>>>"
+                        when (n == line) $ putStrLn (intercalate " " [ marker
+                                                                    , show age
+                                                                    , "violation of rule"
+                                                                    , show rule
+                                                                    , "in line"
+                                                                    , show line <> ":"
+                                                                    , description
+                                                                    ])
+                        putStrLn (code))
 
 
-  choice <- getUserChoice v
-  case choice of
-    Abort -> liftIO $ exitSuccess
-    Annotate annotation -> pure $ Just (AnnotatedViolation v annotation indent)
-    Skip -> pure Nothing
-    Help -> handleViolation content v
+      choice <- getUserChoice v
+      case choice of
+        Abort -> liftIO $ exitSuccess
+        Annotate annotation -> pure $ Just (AnnotatedViolation v annotation indent)
+        Skip -> pure Nothing
+        Help -> handleViolation content v
+  where
+    lookupAnnotation :: Rule -> [Annotation] -> Maybe Annotation
+    lookupAnnotation _ [] = Nothing
+    lookupAnnotation r (a:as)
+      | r == annotationRule a = Just a
+      | otherwise = lookupAnnotation r as
+
+    annotationRule :: Annotation -> Rule
+    annotationRule (Intentional r _) = r
+    annotationRule (FalsePositive r _) = r
+    annotationRule (ToDo r) = r
 
 -- | Get some context around some line
 --

src/Annotator/Annotation.hs

@@ -1,4 +1,5 @@
-module Annotator.Annotation (Annotation(..), showAnnotation) where
+{-# LANGUAGE LambdaCase #-}
+module Annotator.Annotation (Annotation(..), showAnnotation, fromFile) where
 
 import Annotator.Rule
 import Data.Monoid
@@ -12,3 +13,15 @@ showAnnotation :: Annotation -> String -> String
 showAnnotation (Intentional (Rule rule) reason) _ = mconcat ["// ", "coverity[", rule, "_violation", "] ", reason]
 showAnnotation (FalsePositive (Rule rule) reason) _ = mconcat ["// ", "coverity[", rule, "_violation", " : FALSE", "] ", reason]
 showAnnotation (ToDo (Rule rule)) description = "// FIXME violation " <> rule <> ": " <> description
+
+fromFile :: FilePath -> IO [Either String Annotation]
+fromFile fn = fmap safeRead . removeBoring . lines <$> readFile fn
+  where
+    removeBoring :: [String] -> [String]
+    removeBoring = filter (const True)
+
+    safeRead :: String -> Either String Annotation
+    safeRead s = case reads s of
+      [] -> Left "empty line"
+      [(a,"")] -> Right a
+      _ -> Left "invalid line"