Print 10 violations in normal mode

CHANGELOG.md

@@ -2,6 +2,13 @@
 
 Version history.
 
+# 0.2
+
+- [BREAKING:] Flag `--verbose` now takes an optional argument
+  that determines the maximum number of whitespace violations printed per file.
+  This argument is an integer, defaulting to 10, but can be `all`
+  to not limit the number of violations.
+
 # 0.1 Rainy Summer edition released 2023-08-07
 
 - Flag `--verbose` now also displays locations of whitespace violations

FixWhitespace.hs

@@ -4,14 +4,16 @@
 
 module Main where
 
-import           Control.Monad                ( unless, when )
+import           Control.Monad                ( unless, when, forM )
 
 import           Data.List.Extra              ( nubOrd )
+import           Data.Maybe                   ( fromMaybe, isJust )
+import           Data.Text                    ( Text )
 import qualified Data.Text                    as Text
 import qualified Data.Text.IO                 as Text {- Strict IO -}
 import           Data.Version                 ( showVersion )
 
-import           System.Console.GetOpt        ( OptDescr(Option), ArgDescr(NoArg, ReqArg), ArgOrder(Permute), getOpt, usageInfo )
+import           System.Console.GetOpt        ( OptDescr(Option), ArgDescr(NoArg, ReqArg, OptArg), ArgOrder(Permute), getOpt, usageInfo )
 import           System.Directory             ( getCurrentDirectory, doesFileExist )
 import           System.Environment           ( getArgs, getProgName )
 import           System.Exit                  ( die, exitFailure, exitSuccess )
@@ -21,7 +23,7 @@ import           System.IO                    ( IOMode(WriteMode), hPutStr, hPut
 import           Text.Read                    ( readMaybe )
 
 import           Data.Text.FixWhitespace      ( CheckResult(CheckOK, CheckViolation, CheckIOError), checkFile, displayLineError
-                                              , TabSize, Verbose, defaultTabSize )
+                                              , TabSize, Verbose, defaultTabSize, LineError )
 
 import           ParseConfig                  ( Config(Config), parseConfig )
 import qualified Paths_fix_whitespace         as PFW ( version )
@@ -31,14 +33,18 @@ import qualified Paths_fix_whitespace         as PFW ( version )
 defaultConfigFile :: String
 defaultConfigFile = "fix-whitespace.yaml"
 
+-- | Default number of errors printed per file with @--verbose@.
+defaultNumberOfErrors :: Int
+defaultNumberOfErrors = 10
+
 -- Modes.
 data Mode
   = Fix    -- ^ Fix whitespace issues.
   | Check  -- ^ Check if there are any whitespace issues.
     deriving (Show, Eq)
 
 data Options = Options
-  { optVerbose :: Verbose
+  { optVerbose :: Maybe String
   -- ^ Display the location of a file being checked or not.
   , optHelp    :: Bool
   -- ^ Display the help information.
@@ -53,7 +59,7 @@ data Options = Options
 
 defaultOptions :: Options
 defaultOptions = Options
-  { optVerbose = False
+  { optVerbose = Nothing
   , optHelp    = False
   , optVersion = False
   , optMode    = Fix
@@ -70,10 +76,12 @@ options =
       (NoArg (\opts -> opts { optVersion = True }))
       "Show the program's version."
   , Option ['v']     ["verbose"]
-      (NoArg (\opts -> opts { optVerbose = True }))
+      (OptArg (\ms opts -> opts { optVerbose = Just $ fromMaybe (show defaultNumberOfErrors) ms }) "N")
       (unlines
         [ "Show files as they are being checked."
-        , "Display location of detected whitespace violations."
+        , "Display location of detected whitespace violations,"
+        , "up to N per file, or all if N is `all'."
+        , "N defaults to 10."
         ])
   , Option ['t']     ["tab"]
       (ReqArg (\ts opts -> opts { optTabSize = ts }) "TABSIZE")
@@ -153,12 +161,17 @@ main = do
     exitFailure
 
   let mode    = optMode    opts
-      verbose = optVerbose opts
       config  = optConfig  opts
 
   tabSize <- maybe (die "Error: Illegal TABSIZE, must be an integer.") return $
     readMaybe $ optTabSize opts
 
+
+  verbose :: Verbose <- forM (optVerbose opts) $ \case
+    "all" -> pure (maxBound :: Int)
+    s     -> maybe (die "Error: Illegal VERBOSITY, must be an integer or 'all'.") pure $
+      readMaybe s
+
   base <- getCurrentDirectory
 
   files <- if not $ null nonOpts
@@ -178,10 +191,10 @@ main = do
       -- and when not matching an excluded file pattern
       let incPatterns = map ("**/" ++) incFiles
       -- Directory and file patterns to exclude
-      let excPatterns = (map (++ "*") excDirs)
-                     ++ (map ("**/" ++) excFiles)
+      let excPatterns = map (++ "*") excDirs
+                     ++ map ("**/" ++) excFiles
 
-      when verbose $ do
+      when (isJust verbose) $ do
         putStrLn "Include whitelist:"
         putStrLn (unlines incWhitelistPatterns)
 
@@ -207,12 +220,12 @@ fix mode verbose tabSize f =
   checkFile tabSize verbose f >>= \case
 
     CheckOK -> do
-      when verbose $
+      when (isJust verbose) $
         putStrLn $ "[ Checked ] " ++ f
       return False
 
     CheckViolation s vs ->  do
-      hPutStrLn stderr (msg vs)
+      Text.hPutStrLn stderr (msg vs)
       when (mode == Fix) $
         withFile f WriteMode $ \h -> do
           hSetEncoding h utf8
@@ -227,9 +240,19 @@ fix mode verbose tabSize f =
   where
     msg vs
       | mode == Fix =
-        "[ Violation fixed ] " ++ f
+        "[ Violation fixed ] " <> Text.pack f
 
       | otherwise =
-        "[ Violation detected ] " ++ f ++
-        (if not verbose then "" else
-           ":\n" ++ unlines (map (Text.unpack . displayLineError f) vs))
+        "[ Violation detected ] " <> Text.pack f <>
+        (displayViolations verbose vs)
+
+    -- In verbose mode, take initial errors up to maximum verbosity.
+    displayViolations :: Verbose -> [LineError] -> Text
+    displayViolations Nothing _ = Text.empty
+    displayViolations (Just limit) _ | limit <= 0 = Text.empty
+    displayViolations (Just limit) violations = do
+      let (display_violations, more_violations) = splitAt limit violations
+      -- txt should start and end with a newline character.
+      let txt = Text.unlines $ Text.empty : map (displayLineError f) display_violations
+      if null more_violations then txt
+      else txt <> "... and " <> Text.pack (show (length more_violations)) <> " more violations."

fix-whitespace.cabal

@@ -1,6 +1,6 @@
 cabal-version:   2.2
 name:            fix-whitespace
-version:         0.1
+version:         0.2
 build-type:      Simple
 
 category:        Text

src/Data/Text/FixWhitespace.hs

@@ -19,6 +19,7 @@ import           Control.Monad.Trans.Writer.Strict ( Writer, runWriter, tell )
 import           Control.Exception                 ( IOException, handle )
 
 import           Data.Char                         ( GeneralCategory(Space, Format), generalCategory )
+import           Data.Maybe                        ( isJust )
 import           Data.Text                         ( Text )
 import qualified Data.Text                         as Text
 import qualified Data.Text.IO                      as Text  {- Strict IO -}
@@ -27,7 +28,7 @@ import           System.IO                         ( IOMode(ReadMode), hSetEncod
 
 import           Data.List.Extra.Drop              ( dropWhileEnd1, dropWhile1 )
 
-type Verbose = Bool
+type Verbose = Maybe Int
 type TabSize = Int
 
 -- | Default tab size.
@@ -61,7 +62,7 @@ checkFile tabSize verbose f =
       hSetEncoding h utf8
       s <- Text.hGetContents h
       let (s', lvs)
-            | verbose   = transformWithLog tabSize s
+            | isJust verbose = transformWithLog tabSize s
             | otherwise = (transform tabSize s, [])
       return $ if s' == s then CheckOK else CheckViolation s' lvs
 

test/Golden.hs

@@ -34,7 +34,7 @@ goldenTests = do
 
 goldenValue :: FilePath -> IO ByteString
 goldenValue file = do
-  checkFile defaultTabSize {-verbose: -}True file >>= \case
+  checkFile defaultTabSize {-verbose: -} maxVerbosity file >>= \case
 
     CheckIOError e ->
       ioError e
@@ -45,3 +45,5 @@ goldenValue file = do
     CheckViolation _ errs ->
       return $ LazyText.encodeUtf8 $ LazyText.fromStrict $
         Text.unlines $ "Violations:" : map (displayLineError file) errs
+  where
+    maxVerbosity = Just (maxBound :: Int)