Merge branch 'fix/hlint-hints' into 'main'

Fix all found hlint hints

See merge request kobjolke_a/annotator!3

src/Annotator.hs

@@ -1,7 +1,6 @@
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE StrictData #-}
 
 module Annotator (defaultMain) where
 
@@ -17,7 +16,7 @@ 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, nub)
+import Data.List (delete, foldl', sortOn, nub)
 import Data.Char (isSpace)
 import Data.Either (rights)
 import Data.Ord
@@ -104,7 +103,7 @@ options =
     (ReqArg (\f opts -> opts { todoMarker = f }) "STRING")
     "override the default TODO marker with a custom string"
   , Option ['A'] ["annotations"]
-    (ReqArg (\f opts -> opts { annotationFiles = (nub $ annotationFiles opts ++ [f]) }) "FILE")
+    (ReqArg (\f opts -> opts { annotationFiles = f : annotationFiles opts }) "FILE")
     (unlines  [ "load automatic annotation rules"
               , "  some examples:"
               , "     " <> show (Intentional (Rule "rule_1") "some reason")
@@ -124,7 +123,9 @@ readMaybe s = case reads s of
 parseOptions :: [String] -> IO (Options, [String])
 parseOptions argv =
   case getOpt Permute options argv of
-    (o, n, []) -> pure (foldl' (flip id) defaultOptions o, n)
+    (o, n, []) -> do
+      let o' = foldl' (flip id) defaultOptions o
+      pure (o'{annotationFiles = reverse $ nub $ annotationFiles o'}, n)
     (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options))
   where
     header = "Usage: annotator [OPTIONS] files..."
@@ -145,18 +146,18 @@ defaultMain = do
     Just FullVersion -> do
       putStr $ unlines
         [
-          "Annotator v" <> (Vsn.showVersion version)
+          "Annotator v" <> Vsn.showVersion version
         , "Copyright (c) 2022 Alexander Kobjolke <alexander.kobjolke@atlas-elektronik.com>"
         ]
-      exitWith ExitSuccess
+      exitSuccess
     Just ShortVersion -> do
       putStrLn $ Vsn.showVersion version
-      exitWith ExitSuccess
+      exitSuccess
     Nothing -> pure ()
 
   when (showHelp opts) $ do
     putStr $ usageInfo header options
-    exitWith ExitSuccess
+    exitSuccess
 
   automaticAnnotations <- rights . concat <$> (filterM fileExist (annotationFiles opts) >>= mapM fromFile)
 
@@ -165,9 +166,8 @@ defaultMain = do
   runReaderT (genericMain fn) opts'
 
   where
-    header = unlines $
+    header = unlines
-      [
+      [ "Usage: annotator [OPTIONS] files..."
-        "Usage: annotator [OPTIONS] files..."
       , ""
       , "A tool to semi-automatically add Coverity source-code annotations based on found defects."
       , ""
@@ -177,11 +177,11 @@ data Age = Old | New | Newest
   deriving (Show, Eq)
 
 data Violation = Violation {
-  filename :: !FilePath,
+  filename :: FilePath,
-  line :: !Int,
+  line :: Int,
-  age :: !Age,
+  age :: Age,
-  rule :: !Rule,
+  rule :: Rule,
-  description :: !String
+  description :: String
   }
   deriving (Show, Eq)
 
@@ -190,7 +190,7 @@ split _ _ [] = []
 split n p xs
   | n > 0 = case break p xs of
               (match, []) -> [match]
-              (match, (_ : rest)) -> match : split (n-1) p rest
+              (match, _ : rest) -> match : split (n-1) p rest
   | otherwise = [xs]
 
 parseViolations :: String -> [Violation]
@@ -208,7 +208,7 @@ parseViolation s = case split 4 (== ':') s of
     where
       violation = Violation file (read line) a (Rule (removeSuffix "_violation" r)) (dropWhile isSpace $ concat desc)
       (_:age':r:_) = split 2 (== ' ') rule'
-      a = case (delete ',' age') of
+      a = case delete ',' age' of
         "Newest" -> Newest
         "New" -> New
         _ -> Old
@@ -230,7 +230,7 @@ genericMain file = do
       verbose Chatty $ "all violations: " <> show sortedViolations
       forM_ groupedViolations handleViolations
 
-    Nothing -> do
+    Nothing ->
       liftIO $ hPutStrLn stderr "Defects file is empty"
 
   where
@@ -249,10 +249,10 @@ handleViolations violations = do
   let fname = filename $ NE.head violations
       fname' = fname <> ".fix"
       todo = todoMarker opts
-      header' = "Processing " <> (show $ NE.length violations) <> " violation(s) in file " <> fname
+      header' = "Processing " <> show (NE.length violations) <> " violation(s) in file " <> fname
       header = unlines
         [ header'
-        , take (length header') $ repeat '='
+        , replicate (length header') '='
         , ""
         ]
 
@@ -268,15 +268,15 @@ handleViolations violations = do
 
       let numberedContent = zip [1..] . lines $ content
 
-      annotations <- (catMaybes . NE.toList) <$> mapM (handleViolation content) violations
+      annotations <- catMaybes . NE.toList <$> mapM (handleViolation content) violations
 
-      let annotatedLines = sortBy (comparing fst) $ fmap (annotationToLine todo) annotations
+      let annotatedLines = sortOn fst $ fmap (annotationToLine todo) annotations
           newContent = unlines . map snd $ mergeLines annotatedLines numberedContent
 
       liftIO $ writeFile fname' newContent
 
       liftIO $ when (inplace opts) $ rename fname' fname
-    else do
+    else
       verbose Low $ "skipping non-existent file " <> fname
   where
     annotationToLine :: String -> AnnotatedViolation -> (Int, String)
@@ -296,24 +296,17 @@ data UserChoice = Abort
 
 -- | let the user decide what to do with a violation
 getUserChoice :: Violation -> App UserChoice
-getUserChoice Violation{..} = do
+getUserChoice Violation{..} = liftIO queryUser
-  liftIO $ queryUser
     where queryUser = do
-            putStr $ "> What shall we do [s/t/i/f/q/?]: "
+            putStr "> What shall we do [s/t/i/f/q/?]: "
             hFlush stdout
             c <- getChar
             putStrLn ""
             case c of
-              's' -> do
+              's' -> pure Skip
-                pure Skip
+              't' -> pure $ Annotate (ToDo rule)
-              't' -> do
+              'i' -> Annotate . Intentional rule <$> getExcuse
-                pure $ Annotate (ToDo rule)
+              'f' -> Annotate . FalsePositive rule <$> getExcuse
-              'i' -> do
-                excuse <- getExcuse
-                pure $ Annotate (Intentional rule excuse)
-              'f' -> do
-                excuse <- getExcuse
-                pure $ Annotate (FalsePositive rule excuse)
               'q' -> pure Abort
               '?' -> do
                 putStrLn $ unlines [ "t - add TODO marker to fix this issue"
@@ -328,7 +321,7 @@ getUserChoice Violation{..} = do
               _ -> queryUser
 
           getExcuse = do
-            putStr $ "What's your excuse? "
+            putStr "What's your excuse? "
             hFlush stdout
             mode <- hGetBuffering stdin
             hSetBuffering stdin LineBuffering
@@ -349,7 +342,7 @@ type NumberedLine = (Int, String)
 mergeLines :: [NumberedLine] -> [NumberedLine] -> [NumberedLine]
 mergeLines [] r = r
 mergeLines l [] = l
-mergeLines !lhs@(left@(nl,_):ls) !rhs@(right@(nr,_):rs)
+mergeLines lhs@(left@(nl,_):ls) rhs@(right@(nr,_):rs)
   | nl <= nr = left : mergeLines ls rhs
   | otherwise = right : mergeLines lhs rs
 
@@ -379,7 +372,7 @@ handleViolation content v@Violation{..} = do
       -- print some context
       liftIO $ forM_ context (\(n, code) -> do
                         let marker = ">>>>"
-                        when (n == line) $ putStrLn (intercalate " " [ marker
+                        when (n == line) $ putStrLn (unwords [ marker
                                                              , show age
                                                              , "violation of rule"
                                                              , show rule
@@ -387,13 +380,13 @@ handleViolation content v@Violation{..} = do
                                                              , show line <> ":"
                                                              , description
                                                              ])
-                        putStrLn (code))
+                        putStrLn code)
       if batchMode opts
-        then pure $ Nothing
+        then pure Nothing
         else do
           choice <- getUserChoice v
           case choice of
-            Abort -> liftIO $ exitSuccess
+            Abort -> liftIO exitSuccess
             Annotate annotation -> pure $ Just (AnnotatedViolation v annotation indent)
             Skip -> pure Nothing
             Help -> handleViolation content v

src/Annotator/Annotation.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE LambdaCase #-}
 module Annotator.Annotation (Annotation(..), fromFile) where
 
 import Data.Char (isSpace)

src/Annotator/Util.hs

@@ -1,4 +1,4 @@
 module Annotator.Util where
 
 anyp :: [a -> Bool] -> a -> Bool
-anyp preds x = or (map ($ x) preds)
+anyp preds x = any ($ x) preds